C MANUCI SOURCE CB215821 20/11/04 21:18:53 10766 *______________________________________________________________________ * * Donne une valeur en 1 point pour un MCHAML * Appele par MANUCE * * * Entrees : * --------- * * IPMODL Pointeur sur un MMODEL * MOT1 Mot indiquant le type du MCHAML a creer * MOT2 Nom de la composante concernee * IEN1 Numero de l'element * ENT2 Numero du point de gauss * ENT3 Numero de la sous zone concernee * (vaut 1 par defaut - cf. MANUCE) * XFLO Flottant ( Valeur de la composante MOT2 ) * * * Sortie : * -------- * * IPRES Pointeur sur le MCHAML resultat (=0 si erreur) * * EBERSOLT JANVIER 86 * * Passage aux nouveaux MCHAMLs par JM CAMPENON le 06/91 * *______________________________________________________________________ * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) * -INC SMMODEL -INC SMCHAML -INC SMELEME -INC SMINTE -INC PPARAM -INC CCOPTIO * CHARACTER*(*) MOT1, MOT2 * SEGMENT INFO INTEGER INFELL(JG) ENDSEGMENT * PARAMETER (NMOT=22) CHARACTER*8 LISMOT(NMOT) CHARACTER*50 LISTIT(NMOT) INTEGER MSUPPO(NMOT) LOGICAL LSUPNO * EXTERNAL LONG * DATA LISMOT / 'NOEUD ', 'GRAVITE ', 'RIGIDITE', 'MASSE ', 1 'STRESSES', 'DEPLACEM', 'FORCES ', 'REACTUAL', 1 'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT', 1 'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA', 1 'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER', 1 'GRAFLEXI', 'VONMISES'/ * * LES MATERIAU ET CARACTERISTIQUE SONT MIS AUX NOEUDS * * 'NOEUD ', 'GRAVITE ', 'RIGIDITE', 'MASSE ', DATA MSUPPO / 0 , 2 , 3 , 4 , * 'STRESSES', 'DEPLACEM', 'FORCES ', 'REACTUAL', 1 5 , 0 , 0 , 0 , * 'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT', 1 3 , 5 , 5 , 5 , * 'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA', 1 0 , 0 , 5 , 5 , * 'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER', 1 3 , 5 , 5 , 5 , * 'GRAFLEXI', 'VONMISES'/ 1 5 , 5 / * DATA LISTIT / 'NOEUD', 'GRAVITE', 'RIGIDITE', 'MASSE', 1 'STRESSES', 'DEPLACEMENTS', 'FORCES', 1 'REACTUALISATION', 'FORCES VOLUMIQUES', 1 'GRADIENT', 'CONTRAINTES', 'DEFORMATIONS', 1 'CARACTERISTIQUES', 'CARACTERISTIQUES', 1 'TEMPERATURES', 'CONTRAINTES PRINCIPALES', 1 'MATRICE DE HOOKE', 'MATRICE DE HOOKE TANGENTE', 1 'DILATATIONS', 'VARIABLES INTERNES', 1 'GRADIENT DE FLEXION','VON MISES'/ * IPRES = 0 * NHRM=NIFOUR * MMODEL=IPMODL SEGACT MMODEL NSOUS=KMODEL(/1) * IF (IEN3.GT.NSOUS) THEN GOTO 990 ENDIF * * CREATION DU MCHELM * On ne cree qu'un MCHAML a une sous zone * N1=1 IF (MSUPPO(IPLAC).EQ.0) THEN N3=3 ELSE N3=6 ENDIF SEGINI MCHELM TITCHE=LISTIT(IPLAC)(1:L1) IFOCHE=IFOUR * * On active la sous zone concernee * IMODEL=KMODEL(IEN3) SEGACT IMODEL IF(INFMOD(/1).NE.0) THEN NPINT=INFMOD(1) ELSE NPINT = 0 ENDIF IPMAIL=IMAMOD MELEME=IMAMOD MELE =NEFMOD * SEGACT MELEME NBELEM=NUM(/2) IF (MSUPPO(IPLAC).EQ.0) THEN NBPGAU=NUM(/1) ENDIF SEGDES MELEME * IMACHE(1)=IPMAIL CONCHE(1)=CONMOD INFCHE(1,1)=0 INFCHE(1,2)=0 INFCHE(1,3)=NHRM IF (N3.GT.3) INFCHE(1,5)=0 * lsupno=.true. MOCOMP=0 * IF (MSUPPO(IPLAC).NE.0) THEN if(infmod(/1).lt.2+msuppo(iplac)) then IF (IERR.NE.0) GOTO 991 INFO=IPINF MINTE=INFELL(11) SEGSUP INFO else minte=infmod(2+msuppo(iplac)) endif * SEGACT MINTE NBPGAU=POIGAU(/1) SEGDES MINTE ENDIF * * Si le numero du point de gauss ou de l'element est trop eleve * IF(IEN2.GT.NBPGAU.OR.IEN1.GT.NBELEM) THEN GOTO 991 ENDIF * IF (N3.GT.3) THEN INFCHE(1,4)=MINTE INFCHE(1,6)=MSUPPO(IPLAC) ENDIF * * AIGUILLAGE SUIVANT MOT CLE * GOTO ( 1, 1, 1, 1, 1, 6, 7,99,99,10,11,12,13,14,15,16, 2, 2, 1 99,20,99,99) IPLAC * 99 MOTERR(1:8)='MCHAML ' GOTO 991 * 1 NBROBL=1 NBRFAC=0 SEGINI NOMID MOCOMP=NOMID LESOBL(1)='SCAL' GOTO 120 * 2 NBROBL=1 NBRFAC=0 SEGINI NOMID MOCOMP=NOMID LESOBL(1)='MAHO' GOTO 120 * 6 if(lnomid(1).ne.0) then mocomp=lnomid(1) lsupno=.false. else endif GOTO 120 * 7 if(lnomid(2).ne.0) then mocomp=lnomid(2) lsupno=.false. else endif GOTO 120 * 10 if(lnomid(3).ne.0) then mocomp=lnomid(3) lsupno=.false. else endif GOTO 120 * 11 if(lnomid(4).ne.0) then MOCOMP=lnomid(4) lsupno=.false. else endif GOTO 120 * 12 IF(lnomid(5).ne.0) then mocomp=lnomid(5) lsupno=.false. else endif GOTO 120 * 13 if(lnomid(6).ne.0) then MOCOMP=lnomid(6) lsupno=.false. else endif GOTO 120 * 14 if(lnomid(7).ne.0) then MOCOMP=lnomid(7) lsupno=.false. else endif GOTO 120 * 15 if(lnomid(8).ne.0) then MOCOMP=lnomid(8) lsupno=.false. else endif GOTO 120 * 16 if(lnomid(9).ne.0) then MOCOMP=lnomid(9) lsupno=.false. else endif GOTO 120 * 20 if(lnomid(10).ne.0) then MOCOMP=lnomid(10) lsupno=.false. else endif GOTO 120 * 120 CONTINUE NOMID=MOCOMP SEGACT NOMID nobl=lesobl(/2) nfac=lesfac(/2) IF (NOBL.EQ.0.AND.NFAC.EQ.0) THEN GOTO 992 ENDIF * IPLAO=0 IPLAF=0 * * IF (IPLAO.EQ.0) THEN IF(IPLAF.EQ.0) THEN MOTERR(1:4)=MOT1 MOTERR(5:8)=MOT2 GOTO 992 ENDIF ENDIF * * Creation du MCHAML * N2=NOBL+NFAC SEGINI MCHAML ICHAML(1)=MCHAML N1PTEL=NBPGAU N1EL=NBELEM N2PTEL=0 N2EL=0 DO 130 ICOMP=1,NOBL NOMCHE(ICOMP)=LESOBL(ICOMP) TYPCHE(ICOMP)='REAL*8' SEGINI MELVAL IELVAL(ICOMP)=MELVAL DO 230 IGAU=1,N1PTEL DO 230 IB=1,N1EL VELCHE(IGAU,IB)=0.D0 230 CONTINUE IF (IPLAO.EQ.ICOMP) THEN VELCHE(IEN2,IEN1)=XFLO ENDIF SEGDES MELVAL 130 CONTINUE * * CORRECTIONS PP DEC92 : DECALAGE DE NOBL * DO 140 ICOMP=1,NFAC NOMCHE(ICOMP+NOBL)=LESFAC(ICOMP) TYPCHE(ICOMP+NOBL)='REAL*8' SEGINI MELVAL IELVAL(ICOMP+NOBL)=MELVAL DO 240 IGAU=1,N1PTEL DO 240 IB=1,N1EL VELCHE(IGAU,IB)=0.D0 240 CONTINUE IF (IPLAF.EQ.ICOMP) THEN VELCHE(IEN2,IEN1)=XFLO ENDIF SEGDES MELVAL 140 CONTINUE * SEGDES MCHELM IPRES=MCHELM 992 CONTINUE IF (lsupno) SEGSUP,NOMID 991 CONTINUE SEGDES,IMODEL IF (IERR.NE.0) THEN SEGSUP,MCHELM IPRES=0 ENDIF 990 CONTINUE SEGDES MMODEL RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales