1 : C POUVLO SOURCE CHAT 11/03/16 21:29:14 6902 2 : SUBROUTINE POUVLO(IPMODL,MLMOTS,ISUP,ICARA) 3 : *----------------------------------------------------------------------- 4 : * ADDITION DU VECTEUR LOCAL POUR LES POUTRES 5 : * ET LES TUYAUX S'IL EST ABSENT EN 3D 6 : *----------------------------------------------------------------------- 7 : * 8 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 9 : * ----------- 10 : * 11 : * IPMODL (E) POINTEUR D'OBJET MODELE 12 : * MLMOTS (E) POINTEUR SUR LE LISTMOTS DE CARACTERISTIQUES 13 : * ISUP (E) NUMERO DE SUPPORT DEMANDE 14 : * ICARA (E+S) POINTEUR SUR LE CHAMELEM 15 : * 16 : * LANGAGE: 17 : * -------- 18 : * 19 : * ESOPE + FORTRAN77 20 : * 21 : *----------------------------------------------------------------------- 22 : * 23 : IMPLICIT INTEGER(I-N) 24 : IMPLICIT REAL*8(A-H,O-Z) 25 : REAL*8 XEPOU(3,2),VECT(3) 26 : -INC CCOPTIO 27 : -INC CCHAMP 28 : -INC SMCHAML 29 : -INC SMMODEL 30 : -INC SMCOORD 31 : -INC SMLMOTS 32 : -INC SMELEME 33 : * 34 : * SEGMENT INFO 35 : * INTEGER INFELE(JG) 36 : * ENDSEGMENT 37 : CHARACTER*(NCONCH) CONM 38 : * 39 : SEGACT,MLMOTS 40 : * 41 : * LE VECTEUR EXISTE T-IL DEJA ? 42 : * 43 : DO 1 I=1,MOTS(/2) 44 : IF(MOTS(I).EQ.'VECT') THEN 45 : SEGDES MLMOTS 46 : RETURN 47 : ENDIF 48 : 1 CONTINUE 49 : * 50 : * ACTIVATIONS 51 : * 52 : MMODEL=IPMODL 53 : NSOUS=KMODEL(/1) 54 : MCHELM=ICARA 55 : SEGACT MCHELM 56 : * 57 : * BOUCLE SUR LES SOUS ZONES DU MODELE 58 : * 59 : DO 200 ISOUS=1,NSOUS 60 : * 61 : * TRAITEMENT DU MODELE 62 : * 63 : IMODEL=KMODEL(ISOUS) 64 : MELE =NEFMOD 65 : IPMAIL=IMAMOD 66 : CONM =CONMOD 67 : * 68 : * 69 : * INFORMATIONS SUR L'{L{MENT FINI 70 : * 70 : * CALL ELQUOI(MELE,0,ISUP,INFO,IMODEL) 71 : IF (IERR.NE.0) THEN 72 : SEGDES MCHELM 73 : RETURN 74 : ENDIF 75 : MFR =INFELE(13) 76 : IF(MFR.NE.7.AND.MFR.NE.13) THEN 77 : * SEGSUP INFO 78 : GO TO 200 79 : ENDIF 80 : * 81 : * RECHERCHE DE LA ZONE DU CHAMELEM 82 : * 83 : N1 = IMACHE(/1) 84 : N3 = INFCHE(/2) 85 : LAZON = 0 86 : DO 11 I=1,N1 87 : IF (IPMAIL.NE.IMACHE(I) .OR. 88 : . CONM.NE.CONCHE(I)) GO TO 11 89 : LAZON=I 90 : GO TO 12 91 : 11 CONTINUE 92 : * 92 : CALL ERREUR(472) 93 : SEGDES MCHELM 94 : * SEGSUP INFO 95 : RETURN 96 : * 97 : 12 CONTINUE 98 : MCHAML=ICHAML(LAZON) 99 : SEGACT MCHAML 100 : N2=NOMCHE(/2) 101 : N2=N2+1 102 : SEGADJ MCHAML 103 : NOMCHE(N2)='VECT' 104 : TYPCHE(N2)='POINTEURPOINT ' 105 : MELEME=IPMAIL 106 : SEGACT MELEME 107 : NBNN=NUM(/1) 108 : * 109 : * CREATION DU MELVAL ET REMPLISSAGE 110 : * 111 : N1EL=0 112 : N1PTEL=0 113 : N2EL=NUM(/2) 114 : N2PTEL=1 115 : SEGINI MELVAL 116 : IELVAL(N2)=MELVAL 117 : * 118 : DO 305 ID=1,N2EL 118 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,ID,XEPOU) 118 : CALL POULOC(XEPOU,VECT,KERRE) 119 : IF(KERRE.NE.0) THEN 120 : INTERR(1)=ISOUS 121 : INTERR(2)=ID 121 : CALL ERREUR(128) 122 : SEGDES MELEME 123 : SEGDES MELVAL,MCHAML,MCHELM,MLMOTS 124 : * SEGSUP INFO 125 : ENDIF 126 : * 127 : * CREATION DU VECTEUR 128 : * 129 : NBNOI=XCOOR(/1)/(IDIM+1) 130 : NBPTS=NBNOI+1 131 : SEGADJ MCOORD 132 : XCOOR(NBNOI*(IDIM+1)+1)=VECT(1) 133 : XCOOR(NBNOI*(IDIM+1)+2)=VECT(2) 134 : IF (IDIM.EQ.3) XCOOR(NBNOI*(IDIM+1)+3)=VECT(3) 135 : XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=0.D0 136 : IELCHE(1,ID)=NBPTS 137 : 305 CONTINUE 138 : * 139 : * DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS 140 : * 141 : SEGDES MELEME 142 : SEGDES MELVAL 143 : SEGDES MCHAML 144 : * SEGSUP INFO 145 : * 146 : 200 CONTINUE 147 : * 148 : SEGDES MCHELM 149 : SEGDES,MLMOTS 150 : RETURN 151 : END 152 : 153 : 154 : 155 : 156 : 157 : 158 : 159 : 160 :
© Cast3M 2003 - All rights reserved.
Disclaimer