Télécharger kal2p.eso

Retour à la liste

Numérotation des lignes :

  1. C KAL2P SOURCE PV 16/11/17 21:59:43 9180
  2. SUBROUTINE KAL2P(MTABP,MCHB)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5.  
  6. -INC SMTABLE
  7. POINTEUR MTABP.MTABLE,MTABX.MTABLE
  8. *-INC SMMATRAKANC
  9. C*************************************************************************
  10. C
  11. C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees
  12. C
  13.  
  14. * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
  15. * (points CENTRE ) pour chaque operateur de contrainte
  16. * KGEOC SPG pour la totalite des points CENTRE.
  17. * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
  18. * KLEMC Connectivites de l'ensemble des contraintes
  19. * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
  20.  
  21. SEGMENT MATRAK
  22. INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
  23. INTEGER LIZAFM(NBSOUS)
  24. INTEGER IKAM0 (NBSOUS)
  25. INTEGER IMEM (NBELC)
  26. INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
  27. ENDSEGMENT
  28.  
  29. SEGMENT IZAFM
  30. REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX)
  31. ENDSEGMENT
  32.  
  33. POINTEUR IPMJ.IZAFM,IPMK.IZAFM
  34.  
  35. C*******************************************************************
  36. -INC SMELEME
  37. -INC SMLMOTS
  38. -INC SMCHPOI
  39. POINTEUR MPOV1.MPOVAL,IZCH2.MCHPOI,IZCCH2.MPOVAL
  40. POINTEUR MZQP.MPOVAL
  41. -INC CCREEL
  42. CHARACTER*8 TYPE,NOMO,NOM
  43. DIMENSION IXV(3)
  44. C
  45.  
  46.  
  47. CALL LICHT(MCHB,MPOVAL,TYPE,IGEOM)
  48.  
  49. TYPE=' '
  50. CALL ACMO(MTABP,'LISTOPER',TYPE,MLMOTS)
  51.  
  52. IF(TYPE.NE.'LISTMOTS')THEN
  53. RETURN
  54. ENDIF
  55.  
  56. TYPE=' '
  57. CALL ACMO(MTABP,'DELTAT',TYPE,IDT)
  58. IF(TYPE.NE.'FLOTTANT')THEN
  59. DT=XGRAND
  60. ELSE
  61. CALL ACMF(MTABP,'DELTAT',DT)
  62. ENDIF
  63.  
  64. TYPE=' '
  65. CALL ACMO(MTABP,'MATC',TYPE,MATRAK)
  66. IF(TYPE.NE.'MATRAK')THEN
  67. WRITE(6,*)' Pb dans KAL2P : table EQPR erronee '
  68. RETURN
  69. ENDIF
  70. SEGACT MATRAK
  71.  
  72. SEGACT MLMOTS
  73. NBOP=MOTS(/2)
  74.  
  75. DO 1 L=1,NBOP
  76.  
  77. NOMO=MOTS(L)
  78. IF(L.LT.10)THEN
  79. NOM=NOMO(2:5)
  80. ELSE
  81. NOM=NOMO(3:6)
  82. ENDIF
  83.  
  84. C write(6,*)' Second membre NOMO ? ',NOMO
  85. TYPE=' '
  86. CALL ACMO(MTABP,NOMO,TYPE,MTABX)
  87. IF(TYPE.NE.'TABLE')THEN
  88. WRITE(6,*)' Pb dans KAL2P : table EQPR erronee '
  89. RETURN
  90. ENDIF
  91.  
  92. CALL ACME(MTABX,'IARG',IARG)
  93. IF(IARG.EQ.0)THEN
  94. C write(6,*)' pas d''argument pour ',NOMO
  95. GO TO 1
  96. ENDIF
  97.  
  98. TYPE=' '
  99. CALL ACMO(MTABX,'IZCH2',TYPE,IZCH2)
  100. IF(TYPE.NE.'CHPOINT ')THEN
  101. IZCH2=0
  102. ELSE
  103. CALL LICHT(IZCH2,IZCCH2,TYPE,IGEOM)
  104.  
  105. C" nbz=IZCCH2.VPOCHA(/1)
  106. C" write(6,*)' IZCCH2=',IZCCH2,' NBZ=',nbz
  107. C" write(6,1002)(IZCCH2.VPOCHA(II,1),ii=1,nbz)
  108. ENDIF
  109.  
  110. N1=IDEBS(L)
  111. N2=IFINS(L)
  112.  
  113. C" TYPE=' '
  114. C" CALL ACMO(MTABX,'ARG1',TYPE,ICHP)
  115. C" IF(TYPE.EQ.'FLOTTANT')THEN
  116. C" CALL ACMF(MTABX,'ARG1',XVAL)
  117.  
  118.  
  119. CALL LEKTAB(MTABP,'INCO',KINC)
  120.  
  121. CALL LEKTAB(MTABX,'DOMZ',MTABZ)
  122. TYPE=' '
  123. CALL ACMO(MTABZ,'CENTRE',TYPE,MELEMC)
  124. TYPE=' '
  125. CALL ACMO(MTABZ,'SOMMET',TYPE,MELEMS)
  126.  
  127. IF(NOM.EQ.'PRES ')THEN
  128. IXV(1)=MELEMC
  129. IXV(2)=1
  130. IXV(3)=0
  131. CALL LEKCOF('Opérateur PRESSION :',
  132. & MTABX,KINC,1,IXV,MQP,MZQP,NPT1,NC1,IKQ,IRET)
  133. IF(IRET.EQ.0)RETURN
  134. ELSE
  135. IXV(1)=MELEMS
  136. IXV(2)=1
  137. IXV(3)=0
  138. CALL LEKCOF('Opérateur '//NOM//' :',
  139. & MTABX,KINC,1,IXV,MQP,MZQP,NPT1,NC1,IKQ,IRET)
  140. ENDIF
  141.  
  142. C" IF(IKQ.EQ.1)THEN
  143. C"
  144. C" XVAL= MZQP.VPOCHA(1,1)
  145. C"
  146. C" IF(IZCH2.EQ.0)THEN
  147. C" DO 21 I=N1,N2
  148. C" VPOCHA(I,1)=VPOCHA(I,1)+XVAL
  149. C21 CONTINUE
  150. C" ELSE
  151. C" II=0
  152. C" DO 22 I=N1,N2
  153. C" II=II+1
  154. C" VPOCHA(I,1)=VPOCHA(I,1)+XVAL*IZCCH2.VPOCHA(II,1)/DT
  155. C22 CONTINUE
  156. C" SEGDES IZCCH2
  157. C" ENDIF
  158. C" ELSEIF(IKQ.EQ.0)THEN
  159. C" CALL LICHT(ICHP,MPOV1,TYPE,IGEOM)
  160. C write(6,*)' DT=',DT,MZQP.VPOCHA(1,1),' izch2',IZCH2
  161. IF(IZCH2.EQ.0)THEN
  162. II=0
  163. DO 31 I=N1,N2
  164. II=II+1
  165. NKQ=1+(1-IKQ)*(II-1)
  166. C VPOCHA(I,1)=VPOCHA(I,1)+MZQP.VPOCHA(NKQ,1)/(DT*.0.9)
  167. VPOCHA(I,1)=VPOCHA(I,1)+MZQP.VPOCHA(NKQ,1)/DT
  168. 31 CONTINUE
  169. ELSE
  170. II=0
  171. DO 32 I=N1,N2
  172. II=II+1
  173. NKQ=1+(1-IKQ)*(II-1)
  174. VPOCHA(I,1)=VPOCHA(I,1)+
  175. C &MZQP.VPOCHA(NKQ,1)*IZCCH2.VPOCHA(II,1)
  176. &MZQP.VPOCHA(NKQ,1)*IZCCH2.VPOCHA(II,1)/DT
  177. 32 CONTINUE
  178. SEGDES IZCCH2
  179. ENDIF
  180. SEGDES MZQP
  181.  
  182. C" ELSE
  183. C" write(6,*)' On ne fera pas'
  184. C" ENDIF
  185.  
  186. 1 CONTINUE
  187. SEGDES MLMOTS,MATRAK,MPOVAL
  188.  
  189. RETURN
  190. 1001 FORMAT(20(1X,I5))
  191. 1002 FORMAT(10(1X,1PE11.4))
  192. END
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  

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