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