Esope source files

   1 : C KPRJSS    SOURCE    MAGN      10/05/18    21:16:00     6675           
   2 :       SUBROUTINE KPRJSS(MELEME,MELEM2,
   3 :      &IPM1,IPM2,IPM3,IAXI,IKAS,INEFMD,KPRE,IZTGG1,IPAD,IK1,IKOMP)
   4 : 
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C*****************************************************************************
   8 : C
   9 : C     Ce SP calcule les matrices elementaires de divergence alias C
  10 : C
  11 : C  IKAS=1 KMCT calcul de Ct  (Div U)
  12 : C  IKAS=2 KMAC calcul de C uniquement  (Grad p)
  13 : C  IKAS=3 KCCT calcul de C assemblage pour C et Ct
  14 : C
  15 : C*****************************************************************************
  16 :       CHARACTER*8 NOM0
  17 : 
  18 : -INC CCOPTIO
  19 : -INC CCGEOME
  20 : -INC SMCOORD
  21 : -INC SIZFFB
  22 :       POINTEUR IZF1.IZFFM,IZH2.IZHR
  23 : -INC SMMATRIK
  24 : -INC SMELEME
  25 :       POINTEUR MELEM2.MELEME
  26 : -INC SMLENTI
  27 : -INC SMCHPOI
  28 :       POINTEUR IZTGG1.MPOVAL
  29 : -INC CCREEL
  30 :       DIMENSION KIPM(3),XYZ1(24),UA(3),UB(3)
  31 : 
  32 : 
  33 : C OPERATEUR PRESSION
  34 : C
  35 :       MLENTI=IPAD
  36 :       DEUPI=1.D0
  37 :       IF(IAXI.NE.0)DEUPI=2.D0*XPI
  38 :       IF(IKAS.EQ.3)DEUPI=-DEUPI
  39 : 
  40 :       IF(IDIM.EQ.2)IPM3=IPM1
  41 :       KIPM(1)=IPM1
  42 :       KIPM(2)=IPM2
  43 :       KIPM(3)=IPM3
  44 :       SEGACT MELEME,IPM1*MOD,IPM2*MOD,IPM3*MOD
  45 : 
  46 :       NP=NUM(/1)
  47 :       NEL=NUM(/2)
  48 : 
  49 : C     write(6,*)' INEFMD=',inefmd,'KPRE=',kpre
  50 :       IF(KPRE.NE.2)THEN
  51 :        IF(INEFMD.EQ.3)THEN
  52 :        IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'PRP0'
  53 :        IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'PRP1'
  54 :        IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'PFP1'
  55 :        ELSEIF(INEFMD.EQ.2)THEN
  56 :        IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'MCP0'
  57 :        IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'MCP1'
  58 :        IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'MCF1'
  59 :        ELSEIF(INEFMD.EQ.1)THEN
  60 :        IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'P1P1'
  61 :        ELSEIF(INEFMD.EQ.4)THEN
  62 :        NOM0=NOMS(ITYPEL)//'    '
  63 :        ENDIF
  64 : C      write(6,*)' NOM0=',nom0,' ikas=',ikas,' nel=',nel
  64 :        CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  65 : 
  66 :       SEGACT IZFFM*MOD
  67 :       IZHR=KZHR(1)
  68 :       IZH2=KZHR(2)
  69 : 
  70 :       SEGACT IZHR*MOD,IZH2*MOD
  71 : 
  72 :       NES=GR(/1)
  73 :       NPG=GR(/3)
  74 :       IZF1=KTP(1)
  75 :       SEGACT IZF1*MOD
  76 :       MP1=IZF1.FN(/1)
  77 :       MP=MELEM2.NUM(/1)
  78 : 
  79 :       DO 30 KE=1,NEL
  80 : 
  81 : C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% IKOMP = 1 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  82 :       IF(IKOMP.EQ.1)THEN
  83 :       DO 12 I=1,NP
  84 :       J=NUM(I,KE)
  85 :       DO 12 N=1,IDIM
  86 :       XYZ(N,I)=XCOOR((J-1)*(IDIM+1)    +N)
  87 :  12   CONTINUE
  88 : 
  88 :       CALL CALJBR
  89 :      &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  90 : C     write(6,*)' Retour caljbr ',mp1,np,npg
  91 : 
  92 :       DO 324 K=1,IDIM
  93 :       IPM4=KIPM(K)
  94 :       KG=(IK1-4)*(K-1)+1
  95 : 
  96 :       DO 323 M=1,MP1
  97 : 
  98 :       DO 323 I=1,NP
  99 :       U=0.D0
 100 :       DO 333 L=1,NPG
 101 : 
 101 :       CALL INITD(UA,3,0.D0)
 101 :       CALL INITD(UB,3,0.D0)
 102 : 
 103 :       DO 633 J=1,NP
 104 :       J1=LECT(NUM(J,KE))
 105 :       UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)
 106 :       UB(K)=UB(K)+HR(K,J,L)*IZTGG1.VPOCHA(J1,KG)
 107 :  633  CONTINUE
 108 : 
 109 :       U=U+IZF1.FN(M,L)*
 110 :      &(HR(K,I,L)*UA(KG) + FN(I,L)*UB(K ))*PGSQ(L)*DEUPI*RPG(L)
 111 :       IF(IAXI.NE.0.AND.K.EQ.1)THEN
 112 :       U=U+IZF1.FN(M,L)*FN(I,L)*UA(KG)*PGSQ(L)*DEUPI
 113 :       ENDIF
 114 : 
 115 :  333  CONTINUE
 116 : 
 117 : 
 118 :       if(ikas.ne.2)then
 119 :       IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U
 120 :       else
 121 :       IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U
 122 :       endif
 123 : 
 124 :  323  CONTINUE
 125 :  324  CONTINUE
 126 : C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% IKOMP = 0 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 127 :       ELSE
 128 :       DO 13 I=1,NP
 129 :       J=NUM(I,KE)
 130 :       DO 13 N=1,IDIM
 131 :       IZH2.XYZ(N,I)=XCOOR((J-1)*(IDIM+1)    +N)
 132 :  13   CONTINUE
 133 : 
 133 :       CALL CALJBR(IZF1.FN,IZF1.GR,PG,
 134 :      & IZH2.XYZ,IZH2.HR,IZH2.PGSQ,IZH2.RPG,NES,IDIM,MP1,NPG,IAXI,AIRE,
 135 :      & IZH2.AJ,SGN)
 136 : 
 136 : C?    CALL CALJBR
 137 : C?   &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
 138 : C     write(6,*)' Retour caljbr ',mp1,np,npg
 139 : 
 140 :       DO 524 K=1,IDIM
 141 :       IPM4=KIPM(K)
 142 :       KG=(IK1-4)*(K-1)+1
 143 : 
 144 :       DO 523 M=1,MP1
 145 : 
 146 :       DO 523 I=1,NP
 147 :       U=0.D0
 148 :       DO 533 L=1,NPG
 149 : 
 149 :       CALL INITD(UA,3,0.D0)
 149 :       CALL INITD(UB,3,0.D0)
 150 : 
 151 :       DO 733 J=1,NP
 152 :       J1=LECT(NUM(J,KE))
 153 :       UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)
 154 :       UB(K)=UB(K)+IZH2.HR(K,J,L)*IZTGG1.VPOCHA(J1,KG)
 155 :  733  CONTINUE
 156 : 
 157 :       U=U+IZF1.FN(M,L)*
 158 :      &(IZH2.HR(K,I,L)*UA(KG) + FN(I,L)*UB(K ))
 159 :      & *IZH2.PGSQ(L)*DEUPI*IZH2.RPG(L)
 160 : 
 161 :  533  CONTINUE
 162 : 
 163 : 
 164 :       if(ikas.ne.2)then
 165 :       IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U
 166 :       else
 167 :       IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U
 168 :       endif
 169 : 
 170 :  523  CONTINUE
 171 :  524  CONTINUE
 172 : 
 173 :       ENDIF
 174 : C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 175 :  30   CONTINUE
 176 : 
 177 :       SEGSUP IZHR,IZFFM,IZH2
 178 : 
 179 : C CAS MACRO CENTRE
 180 : 
 181 :       ELSEIF(KPRE.EQ.2)THEN
 182 :         NOM0=NOMS(ITYPEL)//'    '
 182 :         CALL KALPBG(NOM0,'FONFORM ',IZFFM)
 183 : 
 184 :         SEGACT IZFFM*MOD
 185 :         IZHR=KZHR(1)
 186 :         IZH2=KZHR(2)
 187 :         SEGACT IZHR*MOD,IZH2*MOD
 188 :         NES=GR(/1)
 189 :         NPG=GR(/3)
 190 :         IZF1=KTP(1)
 191 :         SEGACT IZF1*MOD
 192 :         NPG=IZF1.FN(/2)
 193 :         MP1=IZF1.FN(/1)
 194 :         NP=GR(/2)
 195 : 
 196 :         DO 40 KE=1,NEL
 197 : 
 198 :         IX=0
 199 :         DO 42 I=1,NP
 200 :         J=NUM(I,KE)
 201 :         DO 42 N=1,IDIM
 202 :         IX=IX+1
 203 :         XYZ1(IX)=XCOOR((J-1)*(IDIM+1)    +N)
 204 :  42     CONTINUE
 205 : 
 205 :       CALL CALJBR(FN,GR,PG,XYZ1,HR,PGSQ,RPG,NES,
 206 :      & IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
 207 : 
 208 :       DO 424 K=1,IDIM
 209 :       IPM4=KIPM(K)
 210 :       KG=(IK1-4)*(K-1)+1
 211 : 
 212 :       DO 423 M=1,MP1
 213 :       DO 423 I=1,NP
 214 :       U=0.D0
 215 :       DO 433 L=1,NPG
 216 : 
 216 :       CALL INITD(UA,3,0.D0)
 216 :       CALL INITD(UB,3,0.D0)
 217 :       DO 833 J=1,NP
 218 :       J1=LECT(NUM(J,KE))
 219 :       UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)
 220 :       UB(K)=UB(K)+HR(K,J,L)*IZTGG1.VPOCHA(J1,KG)
 221 :  833  CONTINUE
 222 : 
 223 :       U=U+IZF1.FN(M,L)*
 224 :      &(HR(K,I,L)*UA(KG) + FN(I,L)*UB(K ))*PGSQ(L)*DEUPI*RPG(L)
 225 :       IF(IAXI.NE.0.AND.K.EQ.1)THEN
 226 :       U=U+IZF1.FN(M,L)*FN(I,L)*UA(KG)*PGSQ(L)*DEUPI
 227 :       ENDIF
 228 : 
 229 :  433  CONTINUE
 230 : 
 231 :       if(ikas.ne.2)then
 232 :       IPM4.AM(KE,I,1)=IPM4.AM(KE,I,1)+U
 233 :       else
 234 :       IPM4.AM(KE,1,I)=IPM4.AM(KE,1,I)+U
 235 :       endif
 236 : 
 237 :  423  CONTINUE
 238 :  424  CONTINUE
 239 : 
 240 :  40   CONTINUE
 241 : 
 242 :       SEGSUP IZHR,IZFFM,IZH2
 243 : 
 244 :       ENDIF
 245 : 
 246 :       RETURN
 247 :  1002 FORMAT(10(1X,1PE11.4))
 248 :  1040 FORMAT(1X,'CALCUL MATRICE AM ',I4/10(1X,1PE11.4))
 249 :       END
 250 :  
 251 :  
 252 :  
 253 :  
 254 :  
 255 :  
 256 :  
 257 :  
 258 :  
 259 :  
 260 :  
 261 : 
 262 :  
 263 :  
 264 :  
 265 :  
 266 :  
 267 :  
 268 :