Télécharger la plaquette Cast3M


fr en

Télécharger elpdm2.eso

Retour à la liste

Numérotation des lignes : 

elpdm2

  1. C ELPDM2    SOURCE    CB215821  20/11/04    21:16:36     10766          
  2.       SUBROUTINE ELPDM2(SBORD,SMAT
  3.      &                 ,MCHELM)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-B,D-H,O-Z)
  6.       IMPLICIT COMPLEX*16(C)
  7. ************************************************************************
  8. *
  9. *    PLAQUES  PAR EQUATION INTEGRALE:
  10. *
  11. *       REMPLISSAGE DES TERMES  C.L.     DE LA MATRICE CMA1(NS4,NS4)
  12. *       ET DU SECOND MEMBRE
  13. *   |  A1 B1 C1 D1 A2..............
  14. *   |  E1 F1 G1 H1 A2.............
  15. *   |  -------C.L.------------
  16. *   |  -------C.L.------------
  17. *   |                    ...  A1 B1 C1 D1 ...
  18. *   |                    .... E1 F1 G1 H1....
  19. *   |                        -------C.L.--
  20. *   |                        -------C.L.--
  21. *
  22. *
  23. *   A1  TEL QUE A1 + A2 + .... AN = 0.
  24. *
  25. *
  26. *
  27. *
  28. *
  29. ************************************************************************
  30. *
  31. -INC SMELEME
  32. -INC PPARAM
  33. -INC SMCHAML
  34. *
  35.        SEGMENT SBORD
  36.           REAL*8 XBORD(15,NS)
  37.           INTEGER IBORD (2 ,NS)
  38.        ENDSEGMENT
  39.        SEGMENT SMAT
  40.           COMPLEX*16  CMA1(NS4,NS4)
  41.           COMPLEX*16  CSM (NS4)
  42.           COMPLEX*16  CSOM2 (NS)
  43.           COMPLEX*16  CRE (NS4)
  44.        ENDSEGMENT
  45. *
  46.         CHARACTER*(LOCOMP) NOMC0(4)
  47.          NS = XBORD(/2)
  48.          NS4= CSM  (/1)
  49.  
  50. *
  51. *--1.  MISE A 0 DES LIGNES CONCERNEES
  52. *
  53.          DO 100 I=1,NS
  54.            DO 110 J=1,NS4
  55.              CMA1(4*(I-1) + 3,J) =(0D0,0d0)
  56.              CMA1(4*(I-1) + 4,J) =(0D0,0d0)
  57. 110        CONTINUE
  58. 100      CONTINUE
  59. *
  60. *--2.  ON BALAIE LE CONTENU DU CHAMELEME
  61. *
  62.          NOMC0(1) = 'WW'
  63.          NOMC0(2) = 'WN'
  64.          NOMC0(3) = 'MN'
  65.          NOMC0(4) = 'KN'
  66.          SEGACT MCHELM
  67.          N1 = IMACHE(/1)
  68.  
  69.          DO 200 IM0 =1,N1
  70.             IPT1    =IMACHE(IM0)
  71.             MCHAML = ICHAML(IM0)
  72.             SEGACT IPT1
  73.             SEGACT MCHAML
  74.  
  75.             DO 210 I=1,IPT1.NUM(/2)
  76.               I1 = IPT1.NUM(1,I)
  77.               I2 = IPT1.NUM(3,I)
  78.  
  79.               DO 211 J=1,NS
  80.                 J1 = IBORD(1,J)
  81.                 J2 = IBORD(2,J)
  82.                 IF ( (J1.EQ.I1).AND.(J2.EQ.I2)) THEN
  83.                   JELEM = J
  84.                   GOTO   212
  85.                 ENDIF
  86. 211          CONTINUE
  87. 212          CONTINUE
  88.  
  89.             ILL0= 4*(JELEM - 1)
  90.             DO 220 JC=1,2
  91.               ILL = ILL0 + 2 + JC
  92.               MELVAL = IELVAL(JC)
  93.               SEGACT MELVAL
  94.               IF ( VELCHE(/2) .EQ. 1) THEN
  95.                 CSM (ILL)             =VELCHE(1,1)
  96.               ELSE
  97.                 CSM (ILL)             =VELCHE(1,I)
  98.               ENDIF
  99.               SEGDES MELVAL
  100.               DO 221 KC=1,4
  101.                 IF (NOMCHE(JC).EQ.NOMC0(KC)) THEN
  102.                   CMA1(ILL,ILL0 + KC ) = (1d0 , 0d0)
  103.                 ENDIF
  104. 221          CONTINUE
  105. 220        CONTINUE
  106. 210      CONTINUE
  107.           SEGDES IPT1
  108.           SEGDES MCHAML
  109. 200     CONTINUE
  110.         SEGDES MCHELM
  111.  
  112.  
  113. *
  114.        RETURN
  115.       END
  116.  
  117.  
  118.  
  119.  
  120.  

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