Numérotation des lignes :

C KCALAR    SOURCE    CB215821  16/04/22    21:15:03     8922                 SUBROUTINE KCALAR(NR,XR1,IF1,KF1,XR2,IF2,KF2,NBFA,IFA,IG,NCEL,ICEL     -              ,IC,KA,IM)       IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z) C--------------------------------------------------------------------C Calcul des facteurs de forme en 3DC Sp appele par KPROJACC     DETERMINATION DE LA PROJECTION D' UNE ARETE CONNUE PAR LAC     PROJECTION DE SES SOMMETS SUR L'H.C DE RESOLUTION NRCC--------------------------------------------------------------------      DIMENSION XR1(3),KF1(2),XR2(3),KF2(2)      DIMENSION IFA(3),IG(3,2),NCEL(3),ICEL(3,2,1),IC(2,1)      DIMENSION KA(6),IM(6)      DIMENSION P(3),M1(2),M2(2),KG(2)C      NR2 = NR/2C     WRITE(6,*) ' IF1 IF2 ',IF1,IF2C     WRITE(6,*) ' XR1 ',XR1(1),XR1(2),XR1(3)C     WRITE(6,*) ' XR2 ',XR2(1),XR2(2),XR2(3)      IF ( IF1.EQ.IF2) THEN         NBFA = 1         IFA(1) = IF1         CALL KBRESE(KF1,KF2,NC,IC,KG)         IG(1,1) = KG(1)         IG(1,2) = KG(2)         NCEL(1) = NC         DO 1 I = 1,NC         ICEL(1,1,I) = IC(1,I)         ICEL(1,2,I) = IC(2,I)1        CONTINUE      ELSE      IFA(1) = IF1      IFA(2) = IF2      K1 = KA(IF1)      K2 = KA(IF2)      IF(K1.EQ.K2) THEN         NBFA = 0         RETURN      ELSE      K3 = 6- K1- K2      I1 = IM(IF1)      I2 = IM(IF2)      CALL KPVEC(XR1,XR2,P)C     WRITE(6,*) ' P ',P(1),P(2),P(3)      CV = ABS(P(K3))C     WRITE(6,*) ' CV ',CV      IF (CV.GT.1E-4) THEN        Y = XR1(K3) - (P(K2)/P(K3))*( XR2(K2) - XR1(K2))      ELSE        Y = XR1(K3)      ENDIFC     WRITE(6,*) ' Y ',Y      AY = ABS(Y)       IF(AY.LE.1.001) THEN       NBFA = 2       IIY  = 1 +  INT(NR2*(1.+Y))       IY  = MIN0(NR,IIY)C      WRITE(6,*) ' IY ',IY          IF( K2.LT.K3) THEN                M1(1)  = I2                M1(2)  = IY         ELSE                M1(1)  = IY                M1(2)  = I2         ENDIF         CALL KBRESE(KF1,M1,NC,IC,KG)         NCEL(1) = NC         DO 2 I = 1,NC         ICEL(1,1,I) = IC(1,I)         ICEL(1,2,I) = IC(2,I) 2       CONTINUEC        IG(1,1) = KG(1)C        IG(1,2) = KG(2)         IG(1,1) = M1(1)         IG(1,2) = M1(2)          IF( K1.LT.K3) THEN                M2(1)   = I1                M2(2)   = IY         ELSE                M2(1)   = IY                M2(2)   = I1         ENDIF         CALL KBRESE(KF2,M2,NC,IC,KG)         NCEL(2) = NC         DO 3 I = 1,NC         ICEL(2,1,I) = IC(1,I)         ICEL(2,2,I) = IC(2,I) 3       CONTINUEC        IG(2,1) = KG(1)C        IG(2,2) = KG(2)         IG(2,1) = M2(1)         IG(2,2) = M2(2)       ELSE       NBFA = 3       I3 = IM(IF1)        IF(Y.GT.0.) THEN            Y = 1.            IFA(3) = 2*K3 - 1       ELSE            Y= -1.            IFA(3) = 2*K3       ENDIF       I3 = IM(IFA(3))       CV = ABS(P(K2))      IF (CV.GT.1E-4) THEN       X  = XR1(K2) - (P(K3)/P(K2))*( Y - XR1(K3))      ELSE       X = XR1(K2)      ENDIF       CV = ABS(P(K1))      IF (CV.GT.1E-4) THEN       Z  = XR2(K1) - (P(K3)/P(K1))*( Y - XR2(K3))      ELSE       Z = XR2(K1)      ENDIFC      WRITE(6,*) ' X Z ',X,Z       IIX = 1 +  INT(NR2*(1+X))       IX = MIN0(NR,IIX)       IIZ = 1 +  INT(NR2*(1+Z))       IZ = MIN0(NR,IIZ) C     FACE IF3         IF( K1.LT.K2) THEN                M1(1) = I1                M1(2) = IX                M2(1) = IZ                M2(2) = I2         ELSE                M1(1) = IX                M1(2) = I1                M2(1) = I2                M2(2) = IZ         ENDIF         CALL KBRESE(M1,M2,NC,IC,KG)         NCEL(3) = NC         DO 4 I = 1,NC         ICEL(3,1,I) = IC(1,I)         ICEL(3,2,I) = IC(2,I) 4       CONTINUE         IG(3,1) = KG(1)         IG(3,2) = KG(2) C     FACE IF1         IF( K2.LT.K3) THEN                M1(1) = IX                M1(2) = I3         ELSE                M1(1) = I3                M1(2) = IX         ENDIF         CALL KBRESE(KF1,M1,NC,IC,KG)         NCEL(1) = NC         DO 5 I = 1,NC         ICEL(1,1,I) = IC(1,I)         ICEL(1,2,I) = IC(2,I) 5       CONTINUEC        IG(1,1) = KG(1)C        IG(1,2) = KG(2)         IG(1,1) = M1(1)         IG(1,2) = M1(2) C     FACE IF2         IF( K1.LT.K3) THEN                M2(1) = IZ                M2(2) = I3         ELSE                M2(1) = I3                M2(2) = IZ         ENDIF         CALL KBRESE(KF2,M2,NC,IC,KG)         NCEL(2) = NC         DO 6 I = 1,NC         ICEL(2,1,I) = IC(1,I)         ICEL(2,2,I) = IC(2,I) 6       CONTINUEC        IG(2,1) = KG(1)C        IG(2,2) = KG(2)         IG(2,1) = M2(1)         IG(2,2) = M2(2)       ENDIF      ENDIF      ENDIF C     WRITE(6,*) ' NBFA ',NBFAC     WRITE(6,*) ' IFA  ',(IFA(I),I=1,NBFA)C     WRITE(6,*) ' NCEL ',(NCEL(I),I=1,NBFA)C     DO 10 I = 1,NBFAC     WRITE(6,*) ' IG   ',IG(I,1),IG(I,2)C     WRITE(6,*) ' ICEL ',(ICEL(I,1,K),K=1,NCEL(I))C     WRITE(6,*) ' JCEL ',(ICEL(I,2,K),K=1,NCEL(I))C10   CONTINUEC     WRITE(6,*)      RETURN      END

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