Télécharger la plaquette Cast3M


fr en

Télécharger kam101.eso

Retour à la liste

Numérotation des lignes : 

kam101

  1. C KAM101    SOURCE    CHAT      05/01/13    00:51:04     5004
  2.       SUBROUTINE KAM101(NELA,NEL,NP,IES,LE,AM,XCOOR,IPADL,IKAS,
  3.      & IAXI,NES,NPG,FN,GR,HR,PG,PGSQ,RPG)
  4. C************************************************************************
  5. C   CALCUL DE LA MATRICE M ( P*DIV(U) )  --> AM(NP,IES,NEL)
  6. C
  7. C   IKAS=1  V NORMALE IMPOSEE
  8. C   IKAS=-1 V TANGENTE IMPOSEE
  9. C
  10. C************************************************************************
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8 (A-H,O-Z)
  13.  
  14. C***
  15.       DIMENSION LE(NP,NEL),IPADL(*)
  16.       DIMENSION AM(NELA,IES),XCOOR(*),P3(3,3)
  17.       DIMENSION XYZ(3,9)
  18.       DIMENSION FN(NP,NPG),GR(NES,NP,NPG),HR(IES,NP,NPG)
  19.       DIMENSION PG(NPG),PGSQ(NPG),RPG(NPG)
  20. C***
  21.  
  22.       IF(NP.LE.2.AND.IES.EQ.3)THEN
  23.       WRITE(6,*)' Operateur VNSIMP ou VTSIMP (kam101) :'
  24.       WRITE(6,*)' On ne sait pas traiter ce type d element'
  25.       RETURN
  26.       ENDIF
  27.  
  28. C     write(6,*)' IPADL'
  29. C     write(6,1001)(IPADL(II),ii=1,100)
  30.  
  31.       DO 2 K=1,NEL
  32.       DO 3 I=1,NP
  33.       NU=LE(I,K)
  34.  
  35.       XYZ(1,I)=XCOOR((NU-1)*(IES+1)    +1)
  36.       XYZ(2,I)=XCOOR((NU-1)*(IES+1)    +2)
  37.       IF(IES.EQ.3)XYZ(3,I)=XCOOR((NU-1)*(IES+1)    +3)
  38.  3    CONTINUE
  39. C     write(6,*)' XYZ='
  40. C     write(6,1002) XYZ
  41.  
  42.  
  43.  
  44.       IF(IES.EQ.2)THEN
  45.  
  46.       TX=XYZ(1,2)-XYZ(1,1)
  47.       TY=XYZ(2,2)-XYZ(2,1)
  48.       TT=TX*TX+TY*TY
  49.       TT=SQRT(TT)
  50. C      TX=TX/TT
  51. C      TY=TY/TT
  52.       AX=-TY
  53.       AY=TX
  54.       IF(IKAS.EQ.-1)THEN
  55.       AX=TX
  56.       AY=TY
  57.       ENDIF
  58.       DO 21 J=1,NP
  59.       NU=IPADL(LE(J,K))
  60.       AM(NU,1)=AM(NU,1)+AX
  61.       AM(NU,2)=AM(NU,2)+AY
  62. C      write(6,*)' le,nu=',LE(J,K),NU,' Ax,Ay=',AX,AY
  63. C      write(6,1002)AM(NU,1),AM(NU,2)
  64.  
  65.  21   CONTINUE
  66.  
  67.       ELSEIF(IES.EQ.3)THEN
  68.       IIAXI=0
  69.       CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IES,NP,NPG,IIAXI,AIRE)
  70.       CALL CALJQB(XYZ,P3,IES,NP)
  71.       DO 31 J=1,NP
  72.       NU=IPADL(LE(J,K))
  73.       AM(NU,1)=AM(NU,1)+P3(3,1)*AIRE
  74.       AM(NU,2)=AM(NU,2)+P3(3,2)*AIRE
  75.       AM(NU,3)=AM(NU,3)+P3(3,3)*AIRE
  76. C      write(6,*)' le,nu=',LE(J,K),NU,' Aire=',AIRE
  77. C      write(6,1002)AM(NU,1),AM(NU,2),AM(NU,3)
  78.  31   CONTINUE
  79. C     write(6,*)' P3= AORE=',AIRE
  80. C     write(6,1002)P3
  81.       ENDIF
  82.  2    CONTINUE
  83. C     write(6,*)' Sub kam101 FIN : AM='
  84. C     DO 2101 k=1,nela
  85. C     DO 2101 k=1,10
  86. C     write(6,*)' k=',k
  87. C     write(6,1002)(AM(k,i),i=1,ies)
  88. C2101 CONTINUE
  89.  
  90.       RETURN
  91.  1001 FORMAT(20(1X,I5))
  92.  1002 FORMAT(10(1X,1PE11.4))
  93.       END
  94.  
  95.  

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