Télécharger la plaquette Cast3M


fr en

Télécharger pb603.eso

Retour à la liste

Numérotation des lignes : 

pb603

  1. C PB603     SOURCE    MAGN      10/05/19    21:15:12     6676
  2.       SUBROUTINE PB603(XREF,X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NPG,NOM2)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C************************************************************************
  6. C
  7. C
  8. C
  9. C************************************************************************
  10.  
  11.       REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG)
  12.       CHARACTER*4 NOM2
  13.       DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  14.       DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
  15. * TC n'a pas l'air de servir
  16. *      DIMENSION U(5),H(5),XA(3),XB(3),XC(3),XD(3),XX(3)
  17. **      SAVE XA,XB,XC,XD
  18. *      DATA XA/3*0.25D0/,XB/0.75D0,0.25D0,0.75D0/
  19. *      DATA XC/2*0.75D0,0.25D0/,XD/0.25D0,2*0.75D0/
  20. C***
  21. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  22.       R2=SQRT(2.D0)
  23.       NP2=NP*ND
  24.  
  25.       XREF(1,1)=0.D0
  26.       XREF(2,1)=0.D0
  27.       XREF(3,1)=0.D0
  28.       XREF(1,2)=R2
  29.       XREF(2,2)=0.D0
  30.       XREF(3,2)=0.D0
  31.       XREF(1,3)=0.D0
  32.       XREF(2,3)=R2
  33.       XREF(3,3)=0.D0
  34.  
  35.       XREF(1,4)=0.D0
  36.       XREF(2,4)=0.D0
  37.       XREF(3,4)=1.D0
  38.       XREF(1,5)=R2
  39.       XREF(2,5)=0.D0
  40.       XREF(3,5)=1.D0
  41.       XREF(1,6)=0.D0
  42.       XREF(2,6)=R2
  43.       XREF(3,6)=1.D0
  44.  
  45. C Verification des coordonnées
  46. C     IF(.TRUE.)THEN
  47.       IF(.FALSE.)THEN
  48.       DO 11 L=1,NP
  49.       X(L)=XREF(1,L)
  50.       Y(L)=XREF(2,L)
  51.       Z(L)=XREF(3,L)
  52.  11   CONTINUE
  53.  
  54.       DO 12 L=1,NP
  55.       FN(1,L)=(X(L)+Y(L)-R2)*(Z(L)-1.D0)/R2
  56.       FN(2,L)=-X(L)*(Z(L)-1.D0)/R2
  57.       FN(3,L)=-Y(L)*(Z(L)-1.D0)/R2
  58.       FN(4,L)=-(X(L)+Y(L)-R2)*Z(L)/R2
  59.       FN(5,L)=X(L)*Z(L)/R2
  60.       FN(6,L)=Y(L)*Z(L)/R2
  61.       write(6,1033)L,FN(1,L),FN(2,L),FN(3,L),FN(4,L),FN(5,L),FN(6,L)
  62.  12   CONTINUE
  63.  1033 FORMAT(1X,I4,' FN',10(1X,1PD11.4))
  64.       ENDIF
  65. C Fin Vérification
  66.  
  67.  
  68.  
  69.  
  70.       CALL CALHPR(X,Y,Z,PG,NPG)
  71.  
  72.       DO 1 L=1,NPG
  73. C
  74.       FN(1,L)=(X(L)+Y(L)-R2)*(Z(L)-1.D0)/R2
  75.       FN(2,L)=-X(L)*(Z(L)-1.D0)/R2
  76.       FN(3,L)=-Y(L)*(Z(L)-1.D0)/R2
  77.       FN(4,L)=-(X(L)+Y(L)-R2)*Z(L)/R2
  78.       FN(5,L)=X(L)*Z(L)/R2
  79.       FN(6,L)=Y(L)*Z(L)/R2
  80. C
  81.       GR(1,1,L)=(Z(L)-1.D0)/R2
  82.       GR(2,1,L)=(Z(L)-1.D0)/R2
  83.       GR(3,1,L)=(X(L)+Y(L)-R2)/R2
  84.       GR(1,2,L)=-(Z(L)-1.D0)/R2
  85.       GR(2,2,L)=0.D0
  86.       GR(3,2,L)=-X(L)/R2
  87.       GR(1,3,L)=0.D0
  88.       GR(2,3,L)=-(Z(L)-1.D0)/R2
  89.       GR(3,3,L)=-Y(L)/R2
  90.       GR(1,4,L)=-Z(L)/R2
  91.       GR(2,4,L)=-Z(L)/R2
  92.       GR(3,4,L)=-(X(L)+Y(L)-R2)/R2
  93.       GR(1,5,L)=Z(L)/R2
  94.       GR(2,5,L)=0.D0
  95.       GR(3,5,L)=X(L)/R2
  96.       GR(1,6,L)=0.D0
  97.       GR(2,6,L)=Z(L)/R2
  98.       GR(3,6,L)=Y(L)/R2
  99. C
  100.  
  101.       IF(NOM2.EQ.'P1P1')THEN
  102.       FM(1,L)=FN(1,L)
  103.       FM(2,L)=FN(2,L)
  104.       FM(3,L)=FN(3,L)
  105.       FM(4,L)=FN(4,L)
  106.       FM(5,L)=FN(5,L)
  107.       FM(6,L)=FN(6,L)
  108. C
  109.       GM(1,1,L)=(Z(L)-1.D0)/R2
  110.       GM(2,1,L)=(Z(L)-1.D0)/R2
  111.       GM(3,1,L)=(X(L)+Y(L)-R2)/R2
  112.       GM(1,2,L)=-(Z(L)-1.D0)/R2
  113.       GM(2,2,L)=0.D0
  114.       GM(3,2,L)=-X(L)/R2
  115.       GM(1,3,L)=0.D0
  116.       GM(2,3,L)=-(Z(L)-1.D0)/R2
  117.       GM(3,3,L)=-Y(L)/R2
  118.       GM(1,4,L)=-Z(L)/R2
  119.       GM(2,4,L)=-Z(L)/R2
  120.       GM(3,4,L)=-(X(L)+Y(L)-R2)/R2
  121.       GM(1,5,L)=Z(L)/R2
  122.       GM(2,5,L)=0.D0
  123.       GM(3,5,L)=X(L)/R2
  124.       GM(1,6,L)=0.D0
  125.       GM(2,6,L)=Z(L)/R2
  126.       GM(3,6,L)=Y(L)/R2
  127. C
  128.       ELSE
  129.       FM(1,L)=1.D0
  130.       GM(1,1,L)=0.D0
  131.       GM(2,1,L)=0.D0
  132.       GM(3,1,L)=0.D0
  133.       ENDIF
  134.  
  135.  1    CONTINUE
  136. C     WRITE(6,101)
  137.  
  138. C     WRITE(6,1002)FM
  139. C     WRITE(6,1002)GM
  140. C     WRITE(6,1002)FN
  141. C     WRITE(6,1002)GR
  142. C     WRITE(6,101)
  143.  
  144.       RETURN
  145.  1002 FORMAT(10(1X,1PD11.4))
  146.  1001 FORMAT(20(1X,I5))
  147.  101  FORMAT(1X,'... SUBPB603 ... FM,GM,FN,GR ',9(10H..........)/)
  148. C
  149.       END
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  

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