Télécharger la plaquette Cast3M


fr en

Télécharger mulmel.eso

Retour à la liste

Numérotation des lignes : 

mulmel

  1. C MULMEL    SOURCE    CB215821  23/05/02    21:15:04     11662          
  2. C     
  3.       SUBROUTINE MULMEL(IPMELV,XX,TYPCH1)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6. *_______________________________________________________________________
  7. *
  8. *  ROUTINE MULTIPLIANT un MELVAL IPMELV par un FLOTTTANT XX
  9. *
  10. *  IPMELV : (E/S) POINTEUR SUR UN SEGMENT MELVAL SUPPOSE ACTIF ET EN ECRITURE
  11. *  XX     : (E)   COEFFICIENT MULTIPLICATEUR 
  12. *_______________________________________________________________________
  13. *
  14. -INC SMCHAML
  15.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. -INC SMCOORD
  19.       CHARACTER*(*) TYPCH1
  20.  
  21.       MELVAL=IPMELV
  22.       N1PTEL=MELVAL.VELCHE(/1)
  23.  
  24.       IF(N1PTEL .NE. 0) THEN
  25. C       Cas REAL*8
  26.         N1EL  =MELVAL.VELCHE(/2)
  27.         DO IGAU=1,N1PTEL
  28.           DO IB=1,N1EL
  29.             MELVAL.VELCHE(IGAU,IB)=MELVAL.VELCHE(IGAU,IB) * XX
  30.           ENDDO
  31.         ENDDO
  32.  
  33.       ELSE
  34. C       Cas POINTEUR
  35.         N2PTEL=IELCHE(/1)
  36.         N2EL  =IELCHE(/2)
  37.         IF      (TYPCH1.EQ.'POINTEURLISTREEL') THEN
  38.           DO IGAU=1,N2PTEL
  39.             DO IB=1,N2EL
  40.               ILREE1=IELCHE(IGAU,IB)
  41.               CALL MUFLIR(ILREE1,XX,ILREEL,1)
  42.               IELCHE(IGAU,IB)=ILREEL
  43.             ENDDO
  44.           ENDDO
  45.  
  46.         ELSE IF (TYPCH1.EQ.'POINTEURPOINT   ') THEN
  47.           SEGACT,MCOORD*mod
  48.           NBNO=nbpts
  49.           NBNOI=NBNO
  50.           NBPTS=NBNO+(N2PTEL*N2EL)
  51.           SEGADJ,MCOORD
  52.           DO IGAU=1,N2PTEL
  53.             DO IB=1,N2EL
  54.               IP  =IELCHE(IGAU,IB)
  55.               IREF=(IP-1)*(IDIM+1)
  56. C
  57.               DO IC=1,IDIM
  58.                 XCOOR(NBNOI*(IDIM+1)+IC)=XCOOR(IREF+IC)*XX
  59.               ENDDO
  60.              XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  61.               IELCHE(IGAU,IB)=NBNOI+1
  62.               NBNOI=NBNOI+1
  63.             ENDDO
  64.           ENDDO
  65.           SEGDES,MCOORD
  66.  
  67.         ELSE IF (TYPCH1.EQ.'POINTEUREVOLUTIO') THEN
  68.           DO IGAU=1,N2PTEL
  69.             DO IB=1,N2EL
  70.               IEVOL1=IELCHE(IGAU,IB)
  71.               CALL MUFLEV(IEVOL1,XX,IEVOL2,IEPS)
  72.               IELCHE(IGAU,IB)=IEVOL2
  73.             ENDDO
  74.           ENDDO
  75.  
  76.         ELSE
  77.           MOTERR = TYPCH1
  78.           CALL ERREUR(552)
  79.           RETURN
  80.         ENDIF
  81.       ENDIF
  82.       END 
  83.  
  84.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales