Numérotation des lignes :

C PB403     SOURCE    MAGN      10/05/19    21:15:07     6676      SUBROUTINE PB403(XREF,X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NPG,NOM2)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)C***********************************************************************CC     CALCULE LES FONCTIONS DE FORME D'UN : TET4CC***********************************************************************      CHARACTER*4 NOM2      REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG)      DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)      DIMENSION FM(MP,NPG),GM(ND,MP,NPG)C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>      CO=6.D0 ** (1.D0/3.D0)      UNSCO=1.D0/CO      XXXX=-1.D0*UNSCOC      XREF(1,1)=0.D0      XREF(2,1)=0.D0      XREF(3,1)=0.D0       XREF(1,2)=CO      XREF(2,2)=0.D0      XREF(3,2)=0.D0       XREF(1,3)=0.D0      XREF(2,3)=CO      XREF(3,3)=0.D0       XREF(1,4)=0.D0      XREF(2,4)=0.D0      XREF(3,4)=COC C Verification des coordonnéesC     IF(.TRUE.)THEN      IF(.FALSE.)THEN      DO 11 L=1,NP      X(L)=XREF(1,L)      Y(L)=XREF(2,L)      Z(L)=XREF(3,L) 11   CONTINUE       DO 12 L=1,NPC         FN(1,L)=1.D0-(X(L)+Y(L)+Z(L))*UNSCO         FN(2,L)=X(L)*UNSCO         FN(3,L)=Y(L)*UNSCO         FN(4,L)=Z(L)*UNSCOC      write(6,1033)L,FN(1,L),FN(2,L),FN(3,L),FN(4,L) 12   CONTINUE 1033 FORMAT(1X,I4,' FN',10(1X,1PD11.4))      ENDIFC Fin Vérification       IF(NPG.EQ.1)THEN         XXXX=0.25D0*COC         X(1)=XXXX         Y(1)=XXXX         Z(1)=XXXX         PG(1)=1.D0      ENDIF      IF(NPG.EQ.4)THEN         AL=.5854101966249684D0*CO         BE=.1381966011250105D0*COC         X(1)=BE         Y(1)=BE         Z(1)=BE         PG(1)=0.25D0C         X(2)=AL         Y(2)=BE         Z(2)=BE         PG(2)=0.25D0C         X(3)=BE         Y(3)=AL         Z(3)=BE         PG(3)=0.25D0C         X(4)=BE         Y(4)=BE         Z(4)=AL         PG(4)=0.25D0C      ENDIFC      DO 1 L=1,NPGC         FN(1,L)=1.D0-(X(L)+Y(L)+Z(L))*UNSCO         FN(2,L)=X(L)*UNSCO         FN(3,L)=Y(L)*UNSCO         FN(4,L)=Z(L)*UNSCOC         GR(1,1,L)=XXXX         GR(2,1,L)=XXXX         GR(3,1,L)=XXXXC         GR(1,2,L)=UNSCO         GR(2,2,L)=0.D0         GR(3,2,L)=0.D0C         GR(1,3,L)=0.D0         GR(2,3,L)=UNSCO         GR(3,3,L)=0.D0C         GR(1,4,L)=0.D0         GR(2,4,L)=0.D0         GR(3,4,L)=UNSCOC       IF(NOM2.EQ.'P1P1')THEN      FM(1,L)=FN(1,L)      FM(2,L)=FN(2,L)      FM(3,L)=FN(3,L)      FM(4,L)=FN(4,L)C         GM(1,1,L)=XXXX         GM(2,1,L)=XXXX         GM(3,1,L)=XXXXC         GM(1,2,L)=UNSCO         GM(2,2,L)=0.D0         GM(3,2,L)=0.D0C         GM(1,3,L)=0.D0         GM(2,3,L)=UNSCO         GM(3,3,L)=0.D0C         GM(1,4,L)=0.D0         GM(2,4,L)=0.D0         GM(3,4,L)=UNSCOC      ELSE      FM(1,L)=1.D0      GM(1,1,L)=0.D0      GM(2,1,L)=0.D0      GM(3,1,L)=0.D0      ENDIF  1    CONTINUE C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>C     WRITE(6,100)C     WRITE(6,101)C     WRITE(6,1002)FNC     WRITE(6,1002)GRC     WRITE(6,101)      RETURN 1002 FORMAT(10(1X,1PD11.4)) 1001 FORMAT(20(1X,I5)) 100  FORMAT(1H1) 101  FORMAT(1X,'... SUB PB403 ... FN,GR,FOM,GM ',9(10H..........)/)      END

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