1 : C DEPDPG SOURCE CHAT 11/03/16 21:19:05 6902 2 : 3 : C======================================================================= 4 : C= D E P D P G = 5 : C= ----------- = 6 : C= Extraction du chpoint MCHPOI des deplacements (UZDPG,RXDPG,RYDPG) = 7 : C= du noeud IPDPGE support des deformations planes generalisees = 8 : C======================================================================= 9 : 10 : SUBROUTINE DEPDPG (MCHPOI,UZDPG,RXDPG,RYDPG,IPDPGE) 11 : 12 : IMPLICIT INTEGER(I-N) 13 : IMPLICIT REAL*8 (A-H,O-Z) 14 : 15 : -INC CCOPTIO 16 : -INC CCREEL 17 : -INC SMCHPOI 18 : -INC SMELEME 19 : 20 : CHARACTER*4 NOCO 21 : 22 : C 1 - Controle de la presence du noeud IPDPGE dans le chpoint MCHPOI 23 : C ERREUR si le noeud n'est pas present sauf si tout nul 24 : C === 25 : SEGACT,MCHPOI 26 : NSOUPO=IPCHP(/1) 27 : DO i=1,NSOUPO 28 : MSOUPO=IPCHP(i) 29 : SEGACT,MSOUPO 30 : MELEME=IGEOC 31 : SEGACT,MELEME 32 : DO j=1,NUM(/2) 33 : IF (NUM(1,j).EQ.IPDPGE) GOTO 10 34 : ENDDO 35 : SEGDES,MELEME,MSOUPO 36 : ENDDO 37 : * rattrapage si champ nul 38 : xma=0.d0 39 : do i=1,NSOUPO 40 : MSOUPO=IPCHP(i) 41 : SEGACT,MSOUPO 42 : mpoval=ipoval 43 : if(mpoval.ne.0) then 44 : segact mpoval 45 : do iou=1,vpocha(/2) 46 : do iyu=1,vpocha(/1) 47 : if(abs(vpocha(iyu,iou)).gt.xma)xma=abs(vpocha(iyu,iou)) 48 : enddo 49 : enddo 50 : segdes mpoval 51 : endif 52 : segdes msoupo 53 : enddo 54 : segdes MCHPOI 55 : if(xma.lt.1.d-30) then 56 : UZDPG=0.d0 57 : RXDPG=0.D0 58 : RYDPG=0.D0 59 : RETURN 60 : endif 60 : CALL ERREUR(621) 61 : RETURN 62 : 63 : C 2 - Extraction des deplacements generalises suivant le mode de calcul 64 : C Les composantes generalisees sont rangees dans l'ordre UZDPG, 65 : C RXDPG et RYDPG quelque soit le mode de calcul. 66 : C ERREUR si le nombre de composantes lues n'est pas correct 67 : C === 68 : 10 SEGDES,MELEME 69 : MPOVAL=IPOVAL 70 : SEGACT,MPOVAL 71 : ICOCO=0 72 : C ===== 73 : C 2.1 - Mode PLAN GENE (2D) 74 : C ===== 75 : IF (IFOUR.EQ.-3) THEN 76 : DO i=1,NOCOMP(/2) 77 : NOCO=NOCOMP(i) 78 : IF (NOCO.EQ.'UZ ') THEN 79 : ICOCO=ICOCO+1 80 : UZDPG=VPOCHA(j,i) 81 : ELSE IF (NOCO.EQ.'RX ') THEN 82 : ICOCO=ICOCO+10 83 : RXDPG=VPOCHA(j,i) 84 : ELSE IF (NOCO.EQ.'RY ') THEN 85 : ICOCO=ICOCO+100 86 : RYDPG=VPOCHA(j,i) 87 : ENDIF 88 : ENDDO 88 : IF (ICOCO.NE.111) CALL ERREUR(621) 89 : C ===== 90 : C 2.2 - Modes UNIDIMENSIONNELS (1D) 91 : C ===== 92 : ELSE IF (IFOUR.EQ.7.OR.IFOUR.EQ.8) THEN 93 : RXDPG=XZero 94 : RYDPG=XZero 95 : DO i=1,NOCOMP(/2) 96 : NOCO=NOCOMP(i) 97 : IF (NOCO.EQ.'UY ') THEN 98 : ICOCO=ICOCO+1 99 : UZDPG=VPOCHA(j,i) 100 : ENDIF 101 : ENDDO 101 : IF (ICOCO.NE.1) CALL ERREUR(621) 102 : ELSE IF (IFOUR.EQ.9.OR.IFOUR.EQ.10.OR.IFOUR.EQ.14) THEN 103 : RXDPG=XZero 104 : RYDPG=XZero 105 : DO i=1,NOCOMP(/2) 106 : NOCO=NOCOMP(i) 107 : IF (NOCO.EQ.'UZ ') THEN 108 : ICOCO=ICOCO+1 109 : UZDPG=VPOCHA(j,i) 110 : ENDIF 111 : ENDDO 111 : IF (ICOCO.NE.1) CALL ERREUR(621) 112 : ELSE IF (IFOUR.EQ.11) THEN 113 : RYDPG=XZero 114 : DO i=1,NOCOMP(/2) 115 : NOCO=NOCOMP(i) 116 : IF (NOCO.EQ.'UZ ') THEN 117 : ICOCO=ICOCO+1 118 : UZDPG=VPOCHA(j,i) 119 : ELSE IF (NOCO.EQ.'UY ') THEN 120 : ICOCO=ICOCO+10 121 : RXDPG=VPOCHA(j,i) 122 : ENDIF 123 : ENDDO 123 : IF (ICOCO.NE.11) CALL ERREUR(621) 124 : ENDIF 125 : SEGDES,MPOVAL,MSOUPO,MCHPOI 126 : 127 : RETURN 128 : END 129 : 130 : 131 : 132 :
© Cast3M 2003 - All rights reserved.
Disclaimer