1 : C DYNPLX SOURCE CHAT 09/10/09 21:17:39 6519 2 : SUBROUTINE DYNPLX 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : ************************************************************************ 6 : * 7 : * SOUS-PROGRAMME DE L'OPERATEUR "DYNE" 8 : * ALGORITHME EXPLICITE DE PLEXUS 9 : * ____________________________________ 10 : * 11 : * FONCTION: 12 : * --------- 13 : * LECTURE ET TESTS DE COMPATIBILITE DES OPERANDES 14 : * 15 : * DENIS ROBERT, LE 19 OCTOBRE 1988. 16 : * REVU ET CORRIGE DECEMBRE 89 MP 17 : ************************************************************************ 18 : * 19 : * MODULES UTILISES: 20 : * 21 : -INC CCOPTIO 22 : -INC SMRIGID 23 : -INC SMMATRI 24 : -INC SMVECTD 25 : -INC SMELEME 26 : * 27 : PARAMETER ( ZERO=0.D0 ) 28 : PARAMETER ( EPSI=1.D-30 ) 29 : * 30 : *--- TABLEAUX DE POINTEURS : 31 : * 32 : INTEGER IPRIG(4),IPCGT(2),IPCHM(2),IPPT(6) 33 : * 34 : *--- SEGMENTS DE TRAVAIL : 35 : * -1 T 36 : * MZZZ CONTIENT LE PRODUIT A M A RANGE EN LIGNE 37 : * -1 38 : * MBLO CONTIENT LE PRODUIT A M TABLEAU IDDL * NDDL 39 : * MBLO2 CONTIENT LA MATRICE A TABLEAU IDDL * NDDL 40 : * MUCTRA CONTIENT LES RENSEIGNEMENTS POUR LES PRODUITS K * U 41 : * ICPR CONTIENT DES REFERENCES GEOMETRIQUES 42 : * 43 : SEGMENT,ICPR(XCOOR(/1)/(IDIM+1)) 44 : SEGMENT,MZZZ 45 : REAL*8 ZZZZ(LONZ) 46 : ENDSEGMENT 47 : SEGMENT,MBLO 48 : REAL*8 BLO(IDDL,NDDL) 49 : ENDSEGMENT 50 : POINTEUR MBLO2.MBLO 51 : SEGMENT,MUCTRA 52 : REAL*8 CC(NLIGMA) 53 : INTEGER MUCPO,MUCMIK,MUCDUA,MUIPOS(NLIGMA),MUCPR 54 : ENDSEGMENT 55 : * 56 : *--- INITIALISATIONS 57 : * 58 : DT=ZERO 59 : NINS=0 60 : IRE1=0 61 : IRE3=0 62 : DO 1 I0=1,4 63 : IPRIG(I0)=0 64 : 1 CONTINUE 65 : * END DO 66 : IPCGT(1)=0 67 : IPCGT(2)=0 68 : MCHT=0 69 : IPCHM(1)=0 70 : IPCHM(2)=0 71 : DO 2 I1=1,6 72 : IPPT(I1)=0 73 : 2 CONTINUE 74 : * END DO 75 : * 76 : *--------------------------------------------------* 77 : *--- LECTURE DES OPERANDES DE TYPE 'RIGIDITE' ---* 78 : *--------------------------------------------------* 79 : * 79 : CALL MESLIR(-161) 79 : CALL LIROBJ('RIGIDITE',IPRIG(1),1,IRET) 80 : IF (IERR.NE.0) RETURN 81 : * 81 : CALL MESLIR(-160) 81 : CALL LIROBJ('RIGIDITE',IPRIG(2),1,IRET) 82 : IF (IERR.NE.0) RETURN 83 : * 83 : CALL MESLIR(-159) 83 : CALL LIROBJ('RIGIDITE',IPRIG(3),0,IRET) 84 : IF (IERR.NE.0) RETURN 85 : * 86 : *--------------------------------------------------* 87 : *--- LECTURE DES OPERANDES DE TYPE 'CHARGEME' ---* 88 : *--------------------------------------------------* 89 : * 89 : CALL MESLIR(-158) 89 : CALL LIROBJ('CHARGEME',IPCGT(1),0,IRET) 90 : IF (IERR.NE.0) RETURN 91 : * 91 : CALL MESLIR(-157) 91 : CALL LIROBJ('CHARGEME',IPCGT(2),0,IRET) 92 : IF (IERR.NE.0) RETURN 93 : * 94 : IF (IPCGT(1).EQ.0.AND.IPCGT(2).EQ.0) THEN 95 : * 96 : *--- ON NE TROUVE PAS D'OBJET DE TYPE CHARGEMENT ... 97 : * 98 : MOTERR(1:8)='CHARGEME' 98 : CALL ERREUR(37) 99 : RETURN 100 : ENDIF 101 : * 102 : *-----------------------------------------* 103 : *--- LECTURE DES OPERANDES TEMPORELS ---* 104 : *-----------------------------------------* 105 : * 105 : CALL MESLIR(-156) 105 : CALL LIRREE(DT,1,IRET) 106 : IF (IERR.NE.0) RETURN 107 : IF (DT.LE.EPSI) THEN 108 : * 109 : *--- NOMBRE INACCEPTABLE ... 110 : * 110 : CALL ERREUR(36) 111 : RETURN 112 : ENDIF 113 : * 113 : CALL MESLIR(-155) 113 : CALL LIRENT(NPAS,1,IRET) 114 : IF (IERR.NE.0) RETURN 115 : * 115 : CALL MESLIR(-154) 115 : CALL LIRENT(NINS,0,IRE3) 116 : IF (IERR.NE.0) RETURN 117 : IF (IRE3.EQ.1) THEN 118 : IF (NINS.LT.1) THEN 119 : * 120 : *--- NOMBRE INACCEPTABLE ... 121 : * 121 : CALL ERREUR(36) 122 : RETURN 123 : ENDIF 124 : ELSE 125 : NINS=1 126 : ENDIF 127 : * 127 : CALL MESLIR(-153) 127 : CALL LIRREE(TINI,0,IRE1) 128 : IF (IERR.NE.0) RETURN 129 : IF (IRE1.EQ.0) TINI=ZERO 130 : * 131 : *-----------------------------------------------------------* 132 : *--- LECTURE DE LA TABLE CONTENANT LES CHAMPS INITIAUX ---* 133 : *-----------------------------------------------------------* 134 : * 134 : CALL MESLIR(-152) 134 : CALL LIROBJ('TABLE',ITAB1,1,IRET) 135 : IF (IERR.NE.0) RETURN 136 : * 137 : *------------------------------------------------------------------* 138 : *--- VERIFICATION IDENTIFICATION ET PREPARATION DES OPERANDES ---* 139 : *------------------------------------------------------------------* 140 : * 140 : CALL DYNEVE(IPRIG,ICHT1,ICHT2,ICHT3,ICHT4, 141 : & IPCGT,TINI,DT,NPAS,ITAB1,IPCHM,IPPT) 142 : IF (IERR.NE.0) RETURN 143 : * 144 : MBLO=IPPT(2) 145 : IDDL=BLO(/1) 146 : NDDL=BLO(/2) 147 : * 148 : *----------------------------------------* 149 : *--- MISE EN OEUVRE DE L'ALGORITHME ---* 150 : *----------------------------------------* 151 : * 151 : CALL DYNEPL(IPRIG,ICHT1,ICHT2,ICHT3,ICHT4, 152 : & IPCGT,IDDL,NDDL,DT,NPAS,NINS,IPCHM,IPPT,ITAB2) 153 : IF (IERR.NE.0) RETURN 154 : * 155 : *---------------------------------------* 156 : *--- DESACTIVATIONS / DESTRUCTIONS ---* 157 : *---------------------------------------* 158 : * 159 : MRIGID=IPRIG(2) 160 : NRIGEL=IRIGEL(/2) 161 : DO 100 IRI=1,NRIGEL 162 : MELEME=IRIGEL(1,IRI) 163 : SEGDES,MELEME 164 : DESCR=IRIGEL(3,IRI) 165 : SEGDES,DESCR 166 : xMATRI=IRIGEL(4,IRI) 167 : * NELRIG=re(/3) 168 : * DO 200 IEL=1,NELRIG 169 : * XMATRI=IMATTT(IEL) 170 : * SEGDES,XMATRI 171 : * 200 CONTINUE 172 : * END DO 173 : SEGDES,xMATRI 174 : 100 CONTINUE 175 : * END DO 176 : SEGDES,MRIGID 177 : * 178 : MVECTD=IPPT(1) 179 : SEGSUP,MVECTD 180 : MBLO=IPPT(2) 181 : SEGSUP,MBLO 182 : MBLO=IPPT(3) 183 : SEGSUP,MBLO 184 : * 185 : MUCTRA=IPPT(4) 186 : ICPR=MUCPR 187 : SEGSUP,ICPR 188 : SEGSUP,MUCTRA 189 : * 190 : MMATRI=IPPT(5) 191 : MINCPO=IINCPO 192 : MIMIK=IIMIK 193 : MIDUA=IIDUA 194 : MHARK=IHARK 195 : MELEME=IGEOMA 196 : SEGDES,MELEME,MHARK,MIDUA,MIMIK,MINCPO 197 : SEGDES,MMATRI 198 : IF (IPRIG(3).NE.0) THEN 199 : MRIGID=IPRIG(4) 200 : SEGSUP,MRIGID 201 : MZZZ=IPPT(6) 202 : SEGSUP,MZZZ 203 : ENDIF 204 : * 205 : *---------------------------------------* 206 : *--- ECRITURE DE LA TABLE RESULTAT ---* 207 : *---------------------------------------* 208 : * 208 : CALL ECROBJ('TABLE',ITAB2) 209 : * 210 : END 211 : 212 : 213 : 214 : 215 : 216 : 217 : 218 : 219 :
© Cast3M 2003 - All rights reserved.
Disclaimer