Download prdmf.eso

Back to the list

   1 : C PRDMF     SOURCE    MAGN      09/07/30    21:20:21     6458           
   2 :       SUBROUTINE PRDMF(XVAL,MATRIK,M1)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C     **********************************
   6 : C     * Routine de multiplication      *
   7 : C     * d une matrice et d un flottant *
   8 : C     * XVAL : entree                  *
   9 : C     * MATRIK : Entree                *
  10 : C     * M1 : sortie                    *
  11 : C     **********************************
  12 : 
  13 : -INC SMMATRIK
  14 :       POINTEUR M1.MATRIK
  15 : 
  16 :       REAL*8 XVAL
  17 :       SEGACT MATRIK
  18 :       NMAT = MATRIK.IRIGEL(/2)
  19 :       SEGDES MATRIK
  20 :       IF (NMAT .EQ. 0)THEN
  21 : C     On crée une MATRIK vide
  22 :          NRIGE=7
  23 :          NMATRI=0
  24 :          NKID =9
  25 :          NKMT =7
  26 :          SEGINI M1
  27 :          SEGDES M1
  28 :          RETURN
  29 :       ENDIF
  29 :       CALL MCOPY(MATRIK,M1)
  30 :       SEGACT M1
  31 :       DO IMAT = 1, NMAT, 1
  32 : C     On teste si la matrice est morse ou pas
  33 :          IF (M1.IRIGEL(7,IMAT).EQ.6) THEN
  34 :             IZA=M1.IRIGEL(6,IMAT)
  35 :             SEGACT IZA*MOD
  36 :             NBVA=A(/1)
  37 :             DO I=1,NBVA
  38 :                A(I)=XVAL*A(I)
  39 :             END DO
  40 :             SEGDES IZA
  41 :          END IF
  42 : C
  43 : C     Les matrices elementaires
  44 : C
  45 :          IMATRI=M1.IRIGEL(4,IMAT)
  46 :          SEGACT IMATRI
  47 :          NBSOUS=LIZAFM(/1)
  48 :          NBME=LIZAFM(/2)
  49 :          DO I=1,NBSOUS
  50 :             DO J=1,NBME
  51 :                IZAFM=LIZAFM(I,J)
  52 :                IF (IZAFM.NE.0) THEN
  53 :                   SEGACT IZAFM*MOD
  54 :                   NBEL=AM(/1)
  55 :                   NP=AM(/2)
  56 :                   MP=AM(/3)
  57 : C     On multiplie chaque terme des matrices elementaires.
  58 :                   DO K=1,NBEL
  59 :                      DO L=1,NP
  60 :                         DO M=1,MP
  61 :                            AM(K,L,M)=XVAL*AM(K,L,M)
  62 :                         END DO
  63 :                      END DO
  64 :                   END DO
  65 :                   SEGDES IZAFM
  66 :                END IF
  67 :             END DO
  68 :          END DO
  69 :          SEGDES IMATRI
  70 :       ENDDO
  71 :       SEGDES M1
  72 : C
  73 :       RETURN
  74 :       END
  75 :  
  76 :  
  77 :  
  78 :  
  79 :  

© Cast3M 2003 - All rights reserved.
Disclaimer