Numérotation des lignes :

C KPRJSS    SOURCE    PV        16/11/17    22:00:19     9180                 SUBROUTINE KPRJSS(MELEME,MELEM2,     &IPM1,IPM2,IPM3,IAXI,IKAS,INEFMD,KPRE,IZTGG1,IPAD,IK1,IKOMP)       IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)C*****************************************************************************CC     Ce SP calcule les matrices elementaires de divergence alias CCC  IKAS=1 KMCT calcul de Ct  (Div U)C  IKAS=2 KMAC calcul de C uniquement  (Grad p)C  IKAS=3 KCCT calcul de C assemblage pour C et CtCC*****************************************************************************      CHARACTER*8 NOM0  -INC PPARAM-INC CCOPTIO-INC CCGEOME-INC SMCOORD-INC SIZFFB      POINTEUR IZF1.IZFFM,IZH2.IZHR-INC SMMATRIK-INC SMELEME      POINTEUR MELEM2.MELEME-INC SMLENTI-INC SMCHPOI      POINTEUR IZTGG1.MPOVAL-INC CCREEL      DIMENSION KIPM(3),XYZ1(24),UA(3),UB(3)  C OPERATEUR PRESSIONC      MLENTI=IPAD      DEUPI=1.D0      IF(IAXI.NE.0)DEUPI=2.D0*XPI      IF(IKAS.EQ.3)DEUPI=-DEUPI       IF(IDIM.EQ.2)IPM3=IPM1      KIPM(1)=IPM1      KIPM(2)=IPM2      KIPM(3)=IPM3      SEGACT MELEME,IPM1*MOD,IPM2*MOD,IPM3*MOD       NP=NUM(/1)      NEL=NUM(/2) C     write(6,*)' INEFMD=',inefmd,'KPRE=',kpre      IF(KPRE.NE.2)THEN       IF(INEFMD.EQ.3)THEN       IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'PRP0'       IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'PRP1'       IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'PFP1'       ELSEIF(INEFMD.EQ.2)THEN       IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'MCP0'       IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'MCP1'       IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'MCF1'       ELSEIF(INEFMD.EQ.1)THEN       IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'P1P1'       ELSEIF(INEFMD.EQ.4)THEN       NOM0=NOMS(ITYPEL)//'    '       ENDIFC      write(6,*)' NOM0=',nom0,' ikas=',ikas,' nel=',nel       CALL KALPBG(NOM0,'FONFORM ',IZFFM)       SEGACT IZFFM*MOD      IZHR=KZHR(1)      IZH2=KZHR(2)       SEGACT IZHR*MOD,IZH2*MOD       NES=GR(/1)      NPG=GR(/3)      IZF1=KTP(1)      SEGACT IZF1*MOD      MP1=IZF1.FN(/1)      MP=MELEM2.NUM(/1)       DO 30 KE=1,NEL C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% IKOMP = 1 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%      IF(IKOMP.EQ.1)THEN      DO 12 I=1,NP      J=NUM(I,KE)      DO 12 N=1,IDIM      XYZ(N,I)=XCOOR((J-1)*(IDIM+1)    +N) 12   CONTINUE       CALL CALJBR     &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)C     write(6,*)' Retour caljbr ',mp1,np,npg       DO 324 K=1,IDIM      IPM4=KIPM(K)      KG=(IK1-4)*(K-1)+1       DO 323 M=1,MP1       DO 323 I=1,NP      U=0.D0      DO 333 L=1,NPG       CALL INITD(UA,3,0.D0)      CALL INITD(UB,3,0.D0)       DO 633 J=1,NP      J1=LECT(NUM(J,KE))      UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)      UB(K)=UB(K)+HR(K,J,L)*IZTGG1.VPOCHA(J1,KG) 633  CONTINUE       U=U+IZF1.FN(M,L)*     &(HR(K,I,L)*UA(KG) + FN(I,L)*UB(K ))*PGSQ(L)*DEUPI*RPG(L)      IF(IAXI.NE.0.AND.K.EQ.1)THEN      U=U+IZF1.FN(M,L)*FN(I,L)*UA(KG)*PGSQ(L)*DEUPI      ENDIF  333  CONTINUE        if(ikas.ne.2)then      IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U      else      IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U      endif  323  CONTINUE 324  CONTINUEC%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% IKOMP = 0 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%      ELSE      DO 13 I=1,NP      J=NUM(I,KE)      DO 13 N=1,IDIM      IZH2.XYZ(N,I)=XCOOR((J-1)*(IDIM+1)    +N) 13   CONTINUE       CALL CALJBR(IZF1.FN,IZF1.GR,PG,     & IZH2.XYZ,IZH2.HR,IZH2.PGSQ,IZH2.RPG,NES,IDIM,MP1,NPG,IAXI,AIRE,     & IZH2.AJ,SGN) C?    CALL CALJBRC?   &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)C     write(6,*)' Retour caljbr ',mp1,np,npg       DO 524 K=1,IDIM      IPM4=KIPM(K)      KG=(IK1-4)*(K-1)+1       DO 523 M=1,MP1       DO 523 I=1,NP      U=0.D0      DO 533 L=1,NPG       CALL INITD(UA,3,0.D0)      CALL INITD(UB,3,0.D0)       DO 733 J=1,NP      J1=LECT(NUM(J,KE))      UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)      UB(K)=UB(K)+IZH2.HR(K,J,L)*IZTGG1.VPOCHA(J1,KG) 733  CONTINUE       U=U+IZF1.FN(M,L)*     &(IZH2.HR(K,I,L)*UA(KG) + FN(I,L)*UB(K ))     & *IZH2.PGSQ(L)*DEUPI*IZH2.RPG(L)  533  CONTINUE        if(ikas.ne.2)then      IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U      else      IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U      endif  523  CONTINUE 524  CONTINUE       ENDIFC%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30   CONTINUE       SEGSUP IZHR,IZFFM,IZH2 C CAS MACRO CENTRE       ELSEIF(KPRE.EQ.2)THEN        NOM0=NOMS(ITYPEL)//'    '        CALL KALPBG(NOM0,'FONFORM ',IZFFM)         SEGACT IZFFM*MOD        IZHR=KZHR(1)        IZH2=KZHR(2)        SEGACT IZHR*MOD,IZH2*MOD        NES=GR(/1)        NPG=GR(/3)        IZF1=KTP(1)        SEGACT IZF1*MOD        NPG=IZF1.FN(/2)        MP1=IZF1.FN(/1)        NP=GR(/2)         DO 40 KE=1,NEL         IX=0        DO 42 I=1,NP        J=NUM(I,KE)        DO 42 N=1,IDIM        IX=IX+1        XYZ1(IX)=XCOOR((J-1)*(IDIM+1)    +N) 42     CONTINUE       CALL CALJBR(FN,GR,PG,XYZ1,HR,PGSQ,RPG,NES,     & IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)       DO 424 K=1,IDIM      IPM4=KIPM(K)      KG=(IK1-4)*(K-1)+1       DO 423 M=1,MP1      DO 423 I=1,NP      U=0.D0      DO 433 L=1,NPG       CALL INITD(UA,3,0.D0)      CALL INITD(UB,3,0.D0)      DO 833 J=1,NP      J1=LECT(NUM(J,KE))      UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)      UB(K)=UB(K)+HR(K,J,L)*IZTGG1.VPOCHA(J1,KG) 833  CONTINUE       U=U+IZF1.FN(M,L)*     &(HR(K,I,L)*UA(KG) + FN(I,L)*UB(K ))*PGSQ(L)*DEUPI*RPG(L)      IF(IAXI.NE.0.AND.K.EQ.1)THEN      U=U+IZF1.FN(M,L)*FN(I,L)*UA(KG)*PGSQ(L)*DEUPI      ENDIF  433  CONTINUE       if(ikas.ne.2)then      IPM4.AM(KE,I,1)=IPM4.AM(KE,I,1)+U      else      IPM4.AM(KE,1,I)=IPM4.AM(KE,1,I)+U      endif  423  CONTINUE 424  CONTINUE  40   CONTINUE       SEGSUP IZHR,IZFFM,IZH2       ENDIF       RETURN 1002 FORMAT(10(1X,1PE11.4)) 1040 FORMAT(1X,'CALCUL MATRICE AM ',I4/10(1X,1PE11.4))      END

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