fpma1d
C FPMA1D SOURCE OF166741 25/02/06 21:15:03 12146 C======================================================================= C= Calcul des forces de pressions s'exercant sur les faces d elements = C= massifs unidimensionnels (1D) = C= = C= IPTVPR Pointeur sur un MELVAL contenant les pressions appliquees = C= =0 si on a donne une valeur constante = C= IPMAIL Pointeur sur un MELEME de l'ENVELOPPE = C= IPTINT Pointeur sur un MINTE des caracteristiques d'integration = C= (ACTIF en ENTREE et en SORTIE sans modification) = C= IVAFOR Pointeur sur un MPTVAL (MELVAL) contenant les forces = C= nodales equivalentes = C= XP Valeur de la pression si constante = C======================================================================= & ,netn1,ietn1) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCREEL C= Quelques constantes (2.Pi et 4.Pi) PARAMETER (X2Pi=6.283185307179586476925286766559D0) PARAMETER (X4Pi=12.566370614359172953850573533118D0) -INC SMCHAML -INC SMELEME -INC SMINTE -INC SMCOORD segment netn(notn) segment ietn(letn) SEGMENT WORK REAL*8 XE(3,NBNN) ENDSEGMENT SEGMENT MPTVAL INTEGER IPOS(NS),NSOF(NS) INTEGER IVAL(NCOSOU) CHARACTER*16 TYVAL(NCOSOU) ENDSEGMENT idimp1 = IDIM+1 * prob optimiseur il faut initialiser melva1 melva1 = IPTINT IF (IPTVPR.NE.0) THEN MELVA1=IPTVPR c* SEGACT,MELVA1 <- ACTIF EN E/S c* IVA11=MELVA1.VELCHE(/1) IVA12=MELVA1.VELCHE(/2) ENDIF MINTE=IPTINT C* SEGACT,MINTE <- ACTIF EN E/S NBPGAU=POIGAU(/1) MELEME=IPMAIL c* SEGACT,MELEME <- ACTIF EN E/S NBNN = meleme.NUM(/1) NBELEM = meleme.NUM(/2) C*OF IF ((NBPGAU.NE.1).OR.(NBNN.NE.1)) THEN C*OF WRITE(6,*) 'ERREUR FATALE : FPMA1D' C*OF RETURN C*OF ENDIF SEGINI,WORK netn = netn1 ietn = ietn1 IPT1 = IPMAIM IF (IPT1.GT.0) THEN if (netn.eq.0 .or. ietn.eq.0) then write(ioimp,*) 'FPMA1D : incompatibilite netn, ietn & IPMAIM' endif c* SEGACT,IPT1 <- ACTIF en E/S NBNN1 = ipt1.NUM(/1) NBEL1 = ipt1.NUM(/2) ELSE if (netn.gt.0 .or. ietn.gt.0) then write(ioimp,*) 'FPMA1D : incompatibilite netn, ietn & IPMAIM' endif ENDIF MPTVAL=IVAFOR MELVAL=IVAL(1) C= BOUCLE SUR LES ELEMENTS DO iElt = 1, NBELEM XFLOT = +1.D0 IF (netn.GT.0) THEN DO inf = 1, nbnn ip = meleme.num(inf,ielt) ideb = netn(ip)+1 ifin = netn(ip+1) do itn = ideb, ifin IEM = ietn(itn) jne = 0 do i = 1, nbnn ino = num(i,ielt) do i1 = 1, nbnn1 if (ino.eq.ipt1.num(i1,IEM)) jne=jne+1 enddo enddo if (jne.eq.nbnn) goto 170 enddo ENDDO GOTO 9900 170 continue XG = 0.D0 DO I = 1, NBNN1 ino = (IPT1.NUM(I,IEM)-1)*idimp1 XG=XG+XCOOR(ino+1) ENDDO XG=XG / NBNN1 XK=0.D0 DO i = 1,NBNN XK=XK+XE(1,I) ENDDO XK=XK/NBNN V_1 = XG - XK r_z = 1.D0 / ABS(V_1) V_1 = V_1 * r_z if (v_1.lt.0d0) XFLOT = -1.d0 ENDIF C= Cas des elements AXISymetriques et SPHEriques IF (IFOUR.GE.12.AND.IFOUR.LE.14) THEN ELSE IF (IFOUR.EQ.15) THEN RR=XE(1,1) ELSE ENDIF IF (IPTVPR.NE.0) THEN IEMN=MIN(iElt,IVA12) ELSE ENDIF ENDDO 9900 CONTINUE SEGSUP,WORK c* SEGDES,MINTE <- ACTIF en E/S c* SEGDES,MELEME <- ACTIF en E/S c* IF (IPTVPR.NE.0) SEGDES,MELVA1 <- ACTIF en E/S RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales