C POUVLO SOURCE CB215821 20/11/04 21:19:40 10766 SUBROUTINE POUVLO(IPMODL,MLMOTS,ISUP,ICARA) *----------------------------------------------------------------------- * ADDITION DU VECTEUR LOCAL POUR LES POUTRES * ET LES TUYAUX S'IL EST ABSENT EN 3D *----------------------------------------------------------------------- * * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) * ----------- * * IPMODL (E) POINTEUR D'OBJET MODELE * MLMOTS (E) POINTEUR SUR LE LISTMOTS DE CARACTERISTIQUES * ISUP (E) NUMERO DE SUPPORT DEMANDE * ICARA (E+S) POINTEUR SUR LE CHAMELEM * * LANGAGE: * -------- * * ESOPE + FORTRAN77 * *----------------------------------------------------------------------- * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) REAL*8 XEPOU(3,2),VECT(3) -INC PPARAM -INC CCOPTIO -INC CCHAMP -INC SMCHAML -INC SMMODEL -INC SMCOORD -INC SMLMOTS -INC SMELEME * * SEGMENT INFO * INTEGER INFELE(JG) * ENDSEGMENT CHARACTER*(NCONCH) CONM * SEGACT,MLMOTS * * LE VECTEUR EXISTE T-IL DEJA ? * DO 1 I=1,MOTS(/2) IF(MOTS(I).EQ.'VECT') THEN SEGDES MLMOTS RETURN ENDIF 1 CONTINUE * * ACTIVATIONS * segact mcoord MMODEL=IPMODL NSOUS=KMODEL(/1) MCHELM=ICARA SEGACT MCHELM * * BOUCLE SUR LES SOUS ZONES DU MODELE * DO 200 ISOUS=1,NSOUS * * TRAITEMENT DU MODELE * IMODEL=KMODEL(ISOUS) MELE =NEFMOD IPMAIL=IMAMOD CONM =CONMOD * * * INFORMATIONS SUR L'{L{MENT FINI * * CALL ELQUOI(MELE,0,ISUP,INFO,IMODEL) IF (IERR.NE.0) THEN SEGDES MCHELM RETURN ENDIF MFR =INFELE(13) IF(MFR.NE.7.AND.MFR.NE.13) THEN * SEGSUP INFO GO TO 200 ENDIF * * RECHERCHE DE LA ZONE DU CHAMELEM * N1 = IMACHE(/1) N3 = INFCHE(/2) LAZON = 0 DO 11 I=1,N1 IF (IPMAIL.NE.IMACHE(I) .OR. . CONM.NE.CONCHE(I)) GO TO 11 LAZON=I GO TO 12 11 CONTINUE * CALL ERREUR(472) SEGDES MCHELM * SEGSUP INFO RETURN * 12 CONTINUE MCHAML=ICHAML(LAZON) SEGACT MCHAML N2=NOMCHE(/2) N2=N2+1 SEGADJ MCHAML NOMCHE(N2)='VECT' TYPCHE(N2)='POINTEURPOINT ' MELEME=IPMAIL SEGACT MELEME NBNN=NUM(/1) * * CREATION DU MELVAL ET REMPLISSAGE * N1EL=0 N1PTEL=0 N2EL=NUM(/2) N2PTEL=1 SEGINI MELVAL IELVAL(N2)=MELVAL * DO 305 ID=1,N2EL CALL DOXE(XCOOR,IDIM,NBNN,NUM,ID,XEPOU) CALL POULOC(XEPOU,VECT,KERRE) IF(KERRE.NE.0) THEN INTERR(1)=ISOUS INTERR(2)=ID CALL ERREUR(128) SEGDES MELEME SEGDES MELVAL,MCHAML,MCHELM,MLMOTS * SEGSUP INFO ENDIF * * CREATION DU VECTEUR * segact mcoord*mod NBNOI=nbpts NBPTS=NBNOI+1 SEGADJ MCOORD XCOOR(NBNOI*(IDIM+1)+1)=VECT(1) XCOOR(NBNOI*(IDIM+1)+2)=VECT(2) IF (IDIM.EQ.3) XCOOR(NBNOI*(IDIM+1)+3)=VECT(3) XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=0.D0 IELCHE(1,ID)=NBPTS 305 CONTINUE * * DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS * SEGDES MELEME SEGDES MELVAL SEGDES MCHAML * SEGSUP INFO * 200 CONTINUE * SEGDES MCHELM SEGDES,MLMOTS RETURN END