Sources Esope | Cast3M

depdpg
C DEPDPG    SOURCE    OF166741  24/10/07    21:15:11     12016          
 
C=======================================================================
C=                           D E P D P G                               =
C=                           -----------                               =
C= Extraction du chpoint MCHPOI des deplacements (UZDPG,RXDPG,RYDPG)   =
C= du noeud IPDPGE support des deformations planes generalisees        =
C=======================================================================
 
      SUBROUTINE DEPDPG (MCHPOI,UZDPG,RXDPG,RYDPG,IPDPGE)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
 
-INC SMCHPOI
-INC SMELEME
 
      CHARACTER*(LOCOMP) NOCO
 
C  1 - Controle de la presence du noeud IPDPGE dans le chpoint MCHPOI
C      ERREUR si le noeud n'est pas present sauf si tout nul
C      Le chpoint est suppose ACTIF en E/S
C ===
      NSOUPO=IPCHP(/1)
      DO i=1,NSOUPO
        MSOUPO=IPCHP(i)
        MELEME=IGEOC
        DO j = 1, NUM(/2)
          IF (NUM(1,j).EQ.IPDPGE) GOTO 10
        ENDDO
      ENDDO
* rattrapage si champ nul
      xma=0.d0
      do i=1,NSOUPO
        MSOUPO=IPCHP(i)
        mpoval=ipoval
        if(mpoval.ne.0) then
          do iou=1,vpocha(/2)
            do iyu=1,vpocha(/1)
             if(abs(vpocha(iyu,iou)).gt.xma)xma=abs(vpocha(iyu,iou))
           enddo
          enddo
        endif
      enddo
      if(xma.lt.1.d-30) then
        UZDPG=0.d0
        RXDPG=0.D0
        RYDPG=0.D0
        RETURN
      endif
      CALL ERREUR(621)
      RETURN
 
C  2 - Extraction des deplacements generalises suivant le mode de calcul
C      Les composantes generalisees sont rangees dans l'ordre UZDPG,
C      RXDPG et RYDPG quelque soit le mode de calcul.
C      ERREUR si le nombre de composantes lues n'est pas correct
C ===
 10   CONTINUE
      MPOVAL=IPOVAL
      ICOCO=0
C =====
C  2.1 - Mode PLAN GENE (2D)
C =====
      IF (IFOUR.EQ.-3) THEN
        DO i=1,NOCOMP(/2)
          NOCO=NOCOMP(i)
          IF (NOCO.EQ.'UZ  ') THEN
            ICOCO=ICOCO+1
            UZDPG=VPOCHA(j,i)
          ELSE IF (NOCO.EQ.'RX  ') THEN
            ICOCO=ICOCO+10
            RXDPG=VPOCHA(j,i)
          ELSE IF (NOCO.EQ.'RY  ') THEN
            ICOCO=ICOCO+100
            RYDPG=VPOCHA(j,i)
          ENDIF
        ENDDO
        IF (ICOCO.NE.111) CALL ERREUR(621)
C =====
C  2.2 - Modes UNIDIMENSIONNELS (1D)
C =====
      ELSE IF (IFOUR.EQ.7.OR.IFOUR.EQ.8) THEN
        RXDPG=XZero
        RYDPG=XZero
        DO i=1,NOCOMP(/2)
          NOCO=NOCOMP(i)
          IF (NOCO.EQ.'UY  ') THEN
            ICOCO=ICOCO+1
            UZDPG=VPOCHA(j,i)
          ENDIF
        ENDDO
        IF (ICOCO.NE.1) CALL ERREUR(621)
      ELSE IF (IFOUR.EQ.9.OR.IFOUR.EQ.10.OR.IFOUR.EQ.14) THEN
        RXDPG=XZero
        RYDPG=XZero
        DO i=1,NOCOMP(/2)
          NOCO=NOCOMP(i)
          IF (NOCO.EQ.'UZ  ') THEN
            ICOCO=ICOCO+1
            UZDPG=VPOCHA(j,i)
          ENDIF
        ENDDO
        IF (ICOCO.NE.1) CALL ERREUR(621)
      ELSE IF (IFOUR.EQ.11) THEN
        RYDPG=XZero
        DO i=1,NOCOMP(/2)
          NOCO=NOCOMP(i)
          IF (NOCO.EQ.'UZ  ') THEN
            ICOCO=ICOCO+1
            UZDPG=VPOCHA(j,i)
          ELSE IF (NOCO.EQ.'UY  ') THEN
            ICOCO=ICOCO+10
            RXDPG=VPOCHA(j,i)
          ENDIF
        ENDDO
        IF (ICOCO.NE.11) CALL ERREUR(621)
      ENDIF
 
      RETURN
      END