Esope source files

   1 : C KPRISS    SOURCE    MAGN      10/05/18    21:15:59     6675           
   2 :       SUBROUTINE KPRISS(MELEME,IPM1,IPM2,IPM3,IAXI,IKAS,MACRO,KPRE)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C*****************************************************************************
   6 : C
   7 : C     Ce SP calcule les matrices elementaires de divergence alias C
   8 : C
   9 : C*****************************************************************************
  10 :       CHARACTER*8 NOM0
  11 : 
  12 : -INC CCOPTIO
  13 : -INC CCGEOME
  14 : -INC SMCOORD
  15 : -INC SIZFFB
  16 :       POINTEUR IZF1.IZFFM
  17 : -INC SMMATRIK
  18 : -INC SMELEME
  19 : -INC CCREEL
  20 :       DIMENSION KIPM(3),XYZ1(24)
  21 : 
  22 : 
  23 : C OPERATEUR PRESSION
  24 : C
  25 :       DEUPI=1.D0
  26 :       IF(IAXI.NE.0)DEUPI=2.D0*XPI
  27 : 
  28 : C     write(6,*)' DEUPI=',deupi
  29 :       IF(IDIM.EQ.2)IPM3=IPM1
  30 :       KIPM(1)=IPM1
  31 :       KIPM(2)=IPM2
  32 :       KIPM(3)=IPM3
  33 :       SEGACT MELEME,IPM1*MOD,IPM2*MOD,IPM3*MOD
  34 : 
  35 :       NP=NUM(/1)
  36 :       NEL=NUM(/2)
  37 : 
  38 :       IF(KPRE.NE.2)THEN
  39 :        IF(MACRO.EQ.0)THEN
  40 :        IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'PRP0'
  41 :        IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'PRP1'
  42 :        ELSE
  43 :        IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'MCP0'
  44 :        IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'MCP1'
  45 :        ENDIF
  45 :        CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  46 : C      write(6,*)' NOM0=',nom0,' ikas=',ikas,' nel=',nel
  47 : 
  48 :       SEGACT IZFFM*MOD
  49 :       IZHR=KZHR(1)
  50 :       SEGACT IZHR*MOD
  51 :       NES=GR(/1)
  52 :       NPG=GR(/3)
  53 :       IZF1=KTP(1)
  54 :       SEGACT IZF1*MOD
  55 :       MP1=IZF1.FN(/1)
  56 : 
  57 :       DO 30 KE=1,NEL
  58 :       DO 12 I=1,NP
  59 :       J=NUM(I,KE)
  60 :       DO 12 N=1,IDIM
  61 :       XYZ(N,I)=XCOOR((J-1)*(IDIM+1)    +N)
  62 :  12   CONTINUE
  63 : 
  63 :       CALL CALJBR
  64 :      &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  65 : C     write(6,*)' Retour caljbr ',mp1,np,npg
  66 : 
  67 :       DO 324 K=1,IDIM
  68 :       IPM4=KIPM(K)
  69 : 
  70 :       DO 323 M=1,MP1
  71 : 
  72 :       DO 323 I=1,NP
  73 :       U=0.D0
  74 :       DO 333 L=1,NPG
  75 :       U=U+IZF1.FN(M,L)*HR(K,I,L)*PGSQ(L)*DEUPI*RPG(L)
  76 :  333  CONTINUE
  77 : 
  78 :       IF(IAXI.NE.0.AND.K.EQ.1)THEN
  79 :       DO 334 L=1,NPG
  80 :       U=U+IZF1.FN(M,L)*FN(I,L)*PGSQ(L)*DEUPI
  81 :  334  CONTINUE
  82 :       ENDIF
  83 : 
  84 :       if(ikas.ne.2)then
  85 :       IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U
  86 :       else
  87 :       IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U
  88 :       endif
  89 : 
  90 :  323  CONTINUE
  91 :  324  CONTINUE
  92 : 
  93 :  37   CONTINUE
  94 :  30   CONTINUE
  95 : 
  96 :       SEGSUP IZHR,IZFFM
  97 : 
  98 : 
  99 : C CAS MACRO CENTRE
 100 : 
 101 :       ELSEIF(KPRE.EQ.2)THEN
 102 :         NOM0=NOMS(ITYPEL)//'    '
 102 :         CALL KALPBG(NOM0,'FONFORM ',IZFFM)
 103 : 
 104 :         SEGACT IZFFM*MOD
 105 :         IZHR=KZHR(1)
 106 :         SEGACT IZHR*MOD
 107 :         NES=GR(/1)
 108 :         NPG=GR(/3)
 109 :         IZF1=KTP(1)
 110 :         SEGACT IZF1*MOD
 111 :         MPG=IZF1.FN(/2)
 112 :         NP=GR(/2)
 113 : 
 114 :         DO 40 KE=1,NEL
 115 : 
 116 :         IX=0
 117 :         DO 42 I=1,NP
 118 :         J=NUM(I,KE)
 119 :         DO 42 N=1,IDIM
 120 :         IX=IX+1
 121 :         XYZ1(IX)=XCOOR((J-1)*(IDIM+1)    +N)
 122 :  42     CONTINUE
 123 : 
 123 :       CALL CALJBR(FN,GR,PG,XYZ1,HR,PGSQ,RPG,NES,
 124 :      & IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
 125 : 
 126 :       DO 424 K=1,IDIM
 127 :       IPM4=KIPM(K)
 128 : 
 129 :       DO 423 I=1,NP
 130 :       U=0.D0
 131 :       DO 433 L=1,NPG
 132 :       U=U+HR(K,I,L)*PGSQ(L)*DEUPI*RPG(L)
 133 :  433  CONTINUE
 134 : 
 135 :       IF(IAXI.NE.0.AND.K.EQ.1)THEN
 136 :       DO 434 L=1,NPG
 137 :       U=U+FN(I,L)*PGSQ(L)*DEUPI
 138 :  434  CONTINUE
 139 :       ENDIF
 140 : 
 141 :       if(ikas.ne.2)then
 142 :       IPM4.AM(KE,I,1)=IPM4.AM(KE,I,1)+U
 143 :       else
 144 :       IPM4.AM(KE,1,I)=IPM4.AM(KE,1,I)+U
 145 :       endif
 146 : 
 147 :  423  CONTINUE
 148 :  424  CONTINUE
 149 : 
 150 :  40   CONTINUE
 151 : 
 152 :       SEGSUP IZHR,IZFFM
 153 : 
 154 :       ENDIF
 155 : 
 156 :       RETURN
 157 :  1002 FORMAT(10(1X,1PE11.4))
 158 :  1040 FORMAT(1X,'CALCUL MATRICE AM ',I4/10(1X,1PE11.4))
 159 :       END
 160 :  
 161 :  
 162 :  
 163 :  
 164 :  
 165 :  
 166 :  
 167 :  
 168 :  
 169 :  
 170 :  
 171 :