Sources Esope | Cast3M

chame3
C CHAME3    SOURCE    CB215821  20/11/04    21:15:33     10766          
 
      SUBROUTINE CHAME3(IPMELV,IPMINT,IPRES,IPORE,LENAME,MELE)
 
*_______________________________________________________________________
*
*   CALCUL DES MELVALS AU SUPPORT DE IPMINT
*   IDENTIQUE A VALMEL AVEC EN SUPPLEMENT IPORE
*
*   IPMELV  POINTEUR SUR UN SEGMENT MELVAL A RECALCULER
*           (SUPPOSE ACTIF)
*
*   IPMINT  POINTEUR SUR LE SEGMENT D'INTEGRATION DU SUPPORT OU L'ON
*           SOUHAITE PROJETER LE MELVAL
*           LE POINTEUR IPMINT DOIT ETRE ACTIF EN ENTREE DE CHAME3
*           ET SON ETAT N'EST PAS MODIFIE DANS CHAME3.
*
*   IPRES   POINTEUR SUR LE MELVAL RESULTAT
*           (ACTIF EN SORTIE)
*
*   IPORE   0 SAUF POUR MILIEU POREUX ( NBRE DE NOEUDS )
*
*   CAMPENON JM LE 02/91
*
*_______________________________________________________________________
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
 
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC SMCHAML
-INC SMINTE
*
      CHARACTER*(LOCOMP) LENAME
*
      MELVAL=IPMELV
      N1PTEL=VELCHE(/1)
      N2PTEL=IELCHE(/1)
      IF(N2PTEL.NE.0)THEN
        IF(N2PTEL.EQ.1)THEN
          SEGINI,MELVA1=MELVAL
          IPRES=MELVA1
          RETURN
        ELSE
          MOTERR(1:8)=' '
          CALL ERREUR(124)
          IPRES=IPMELV
          RETURN
        ENDIF
      ELSE
*
        IF (N1PTEL.EQ.1) THEN
          SEGINI,MELVA1=MELVAL
          IPRES=MELVA1
          RETURN
        ELSE
*
*     ON RECUPERE LE NOMBRE DE POINTS SUPPORT
*
         MINTE=IPMINT
C**      SEGACT MINTE                       &lt;- Actif en ENTREE
         NBPGAU=SHPTOT(/3)
         IF(IPORE.EQ.0) THEN
           NBNO  =SHPTOT(/2)
         ELSE
           NBNO  =IPORE
         ENDIF
*
         N1PTEL=NBPGAU
         IVEL=VELCHE(/1)
         N1EL=VELCHE(/2)
         N2PTEL=0
         N2EL  =0
         SEGINI MELVA1
         IPRES= MELVA1
*
*  AM  14/4/16 CAS DES JOINTS
*
         MELGEO=NUMGEO(MELE)
         IF( MELGEO.EQ.12.OR.MELGEO.EQ.13.OR.MELGEO.EQ.29
     &   .OR.MELGEO.EQ.30.OR.MELGEO.EQ.31) THEN
*
           IDECA=0
           IF(MELGEO.EQ.29) IDECA=2
           IF(MELGEO.EQ.30) IDECA=3
           IF(MELGEO.EQ.31) IDECA=4
           NBNOU=NBNNE(MELGEO)-IDECA
           NBNOV=NBNO - IDECA
*
           IF(LENAME.EQ.'P '.OR.LENAME.EQ.'PQ '
     &                      .OR.LENAME.EQ.'TP ') THEN
 
             NBNOV=NBNO - IDECA
             DO 7 IB=1,N1EL
               DO 8 IGAU=1,NBPGAU
                 XVAL1=0.D0
*                DO 9 INBNO=NBNO-IDECA+1,NBNO
                 DO 9 INBNO=1,IDECA
                  INBNO1 = NBNOU + INBNO
                  INBNO2 = NBNOV + INBNO
                  IGMN   = MIN(IVEL,INBNO1)
                  XVAL1=XVAL1+VELCHE(IGMN,IB)*SHPTOT(1,INBNO2,IGAU)
 9               CONTINUE
                 MELVA1.VELCHE(IGAU,IB)=XVAL1
 8             CONTINUE
 7           CONTINUE
 
           ELSE
             FAC=2.D0
             IF((MELGEO.EQ.12.OR.MELGEO.EQ.13).AND.NBNOU.GT.NBNO) THEN
                 NBNOU=NBNO
                 FAC=1.D0
             ENDIF
 
             DO 4 IB=1,N1EL
               DO 5 IGAU=1,NBPGAU
                 XVAL1=0.D0
                 DO 6 INBNO=1,NBNOU
                  IGMN=MIN(IVEL,INBNO)
                  XVAL1=XVAL1+ VELCHE(IGMN,IB)*SHPTOT(1,INBNO,IGAU)
 6               CONTINUE
                 MELVA1.VELCHE(IGAU,IB)=XVAL1/FAC
 5             CONTINUE
 4           CONTINUE
           ENDIF
*
*      LES AUTRES CAS
*
         ELSE
           DO 1 IB=1,N1EL
             DO 2 IGAU=1,NBPGAU
               XVAL1=0.D0
               DO 3 INBNO=1,NBNO
                  IGMN=MIN(IVEL,INBNO)
                  XVAL1=XVAL1+VELCHE(IGMN,IB)*SHPTOT(1,INBNO,IGAU)
 3             CONTINUE
               MELVA1.VELCHE(IGAU,IB)=XVAL1
 2           CONTINUE
 1         CONTINUE
         ENDIF
        ENDIF
      ENDIF
*
C**   SEGDES MELVAL                         &lt;- Actif en SORTIE
C**   SEGDES MINTE                          &lt;- Actif en SORTIE
*
      RETURN
      END