Télécharger kdom4c.eso

Retour à la liste

Numérotation des lignes :

  1. C KDOM4C SOURCE CHAT 05/01/13 00:54:19 5004
  2. SUBROUTINE KDOM4C(MELF,MELFL,MELFP,MCHPSU,MCHPNO,MCHPMR)
  3. C
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : KDOM4C
  9. C Subroutine called by KDOM4A
  10. C Axial-symmetric case, TRI7 and QUA8
  11. C We compute
  12. C MTAB . 'XXSURFAC'
  13. C MTAB . 'XXNORMAF'
  14. C MTAB . 'MATROT'
  15. C and we change the position for the central points
  16. C of MELEMQ
  17. C
  18. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  19. C
  20. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF
  21. C
  22. C
  23. C************************************************************************
  24. C
  25. C INPUTS :
  26. C
  27. C MELF : meleme 'FACE'
  28. C MELFL : meleme 'FACEL'
  29. C MELFP : meleme 'FACEP'
  30. C
  31. C OUTPUTS :
  32. C
  33. C MCHPSU : mchpoi 'XXSURFAC'
  34. C MCHPNO : mchpoi 'XXNORMAF'
  35. C MCHPMR : mchpoi 'MATROT'
  36. C
  37. C***********************************************************
  38. C
  39. C Created the 24/02/04
  40. C
  41. C**** Variables of CCOPTIO
  42. C
  43. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  44. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  45. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  46. C & ,IECHO, IIMPI, IOSPI
  47. C & ,IDIM
  48. CC & ,MCOORD
  49. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  50. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  51. C & ,NORINC,NORVAL,NORIND,NORVAD
  52. C & ,NUCROU, IPSAUV, IFICLE, IPREFI, IREFOR, ISAFOR
  53. C
  54. IMPLICIT INTEGER(I-N)
  55. INTEGER IGEOM, MCHPSU, MCHPNO, MCHPMR
  56. & ,JGN, JGM, NP, NEL, IEL, NLCF
  57. & , NF, IP1, IP2
  58. REAL*8 X1,X2,Y1,Y2,SURF,XF,YF,DX,DY,DVAL,DNX,DNY,DTX,DTY,ORIENT
  59. CHARACTER*8 TYPE
  60.  
  61. -INC CCOPTIO
  62. -INC SMELEME
  63. POINTEUR MELFL.MELEME,MELFP.MELEME,MELF.MELEME
  64. -INC SMCHPOI
  65. POINTEUR MPOVSU.MPOVAL, MPOVNO.MPOVAL, MPOVMR.MPOVAL
  66. -INC SMLENTI
  67. -INC SMLMOTS
  68. -INC SMCOORD
  69. C
  70. C**** Corresp. FACE
  71. C
  72. CALL KRIPAD(MELF,MLENTI)
  73. C SEGINI MLENTI
  74. C
  75. C**** Champoint surfaces
  76. C
  77. JGN=4
  78. JGM=1
  79. SEGINI MLMOTS
  80. MLMOTS.MOTS(1)='SCAL'
  81. TYPE='FACE '
  82. CALL KRCHP1(TYPE,MELF,MCHPSU,MLMOTS)
  83. IF(IERR.NE.0)GOTO 9999
  84. CALL LICHT(MCHPSU,MPOVSU,TYPE,IGEOM)
  85. IF(IERR.NE.0)GOTO 9999
  86. C SEGACT MPOVSU
  87. SEGSUP MLMOTS
  88. C
  89. C**** Champoint normales
  90. C
  91. JGN=4
  92. JGM=IDIM
  93. SEGINI MLMOTS
  94. MLMOTS.MOTS(1)='UX'
  95. MLMOTS.MOTS(2)='UY'
  96. TYPE='FACE '
  97. CALL KRCHP1(TYPE,MELF,MCHPNO,MLMOTS)
  98. IF(IERR.NE.0)GOTO 9999
  99. CALL LICHT(MCHPNO,MPOVNO,TYPE,IGEOM)
  100. IF(IERR.NE.0)GOTO 9999
  101. C SEGACT MPOVNO
  102. SEGSUP MLMOTS
  103. C
  104. C**** Champoint matrice de rotation
  105. C
  106. JGN=4
  107. JGM=IDIM*IDIM
  108. SEGINI MLMOTS
  109. C IF(IDIM.EQ.2)THEN
  110. MLMOTS.MOTS(1)='RX'
  111. MLMOTS.MOTS(2)='RY'
  112. MLMOTS.MOTS(3)='MX'
  113. MLMOTS.MOTS(4)='MY'
  114. * Normale en M
  115. * vect(M,U) = z
  116. C ENDIF
  117. CALL KRCHP1(TYPE,MELF,MCHPMR,MLMOTS)
  118. IF(IERR.NE.0)GOTO 9999
  119. CALL LICHT(MCHPMR,MPOVMR,TYPE,IGEOM)
  120. IF(IERR.NE.0)GOTO 9999
  121. C SEGACT MPOVMR
  122. C
  123. SEGACT MELFP
  124. C In the case 2D, NBSOUS=1
  125. SEGACT MELFL
  126. C
  127. NP=MELFP.NUM(/1)-1
  128. NEL=MELFP.NUM(/2)
  129. IF(NP .NE. 2)THEN
  130. WRITE(IOIMP,*) 'Subroutine kdom4c.eso'
  131. CALL ERREUR(5)
  132. ENDIF
  133. C
  134. DO IEL=1,NEL,1
  135. C X1,Y1,X2,Y2,XF,YF
  136. NF=MELFP.NUM(NP+1,IEL)
  137. IP1=MELFP.NUM(1,IEL)
  138. IP2=MELFP.NUM(2,IEL)
  139. X1=XCOOR((IP1-1)*(IDIM+1)+1)
  140. Y1=XCOOR((IP1-1)*(IDIM+1)+2)
  141. X2=XCOOR((IP2-1)*(IDIM+1)+1)
  142. Y2=XCOOR((IP2-1)*(IDIM+1)+2)
  143. CALL KDOM3B(X1,Y1,X2,Y2,SURF,XF,YF)
  144. XCOOR((NF-1)*(IDIM+1)+1)=XF
  145. XCOOR((NF-1)*(IDIM+1)+2)=YF
  146. NLCF=MLENTI.LECT(NF)
  147. MPOVSU.VPOCHA(NLCF,1)=SURF
  148. DX=X1-XF
  149. DY=Y1-YF
  150. DVAL=((DX*DX)+(DY*DY))**0.5D0
  151. DNX=DY/DVAL
  152. DNY=-1.0D0*DX/DVAL
  153. DTX=DX/DVAL
  154. DTY=DY/DVAL
  155. C
  156. C******* Orientation selon FACEL
  157. C
  158. IP1=MELFL.NUM(1,NLCF)
  159. X1=XCOOR((IP1-1)*(IDIM+1)+1)
  160. Y1=XCOOR((IP1-1)*(IDIM+1)+2)
  161. DX=XF-X1
  162. DY=YF-Y1
  163. ORIENT=SIGN(1.0D0,((DNX*DX)+(DNY*DY)))
  164. C
  165. MPOVNO.VPOCHA(NLCF,1)=DNX*ORIENT
  166. MPOVNO.VPOCHA(NLCF,2)=DNY*ORIENT
  167. C
  168. MPOVMR.VPOCHA(NLCF,3)=DNX*ORIENT
  169. MPOVMR.VPOCHA(NLCF,4)=DNY*ORIENT
  170. MPOVMR.VPOCHA(NLCF,1)=DTX*ORIENT
  171. MPOVMR.VPOCHA(NLCF,2)=DTY*ORIENT
  172. C
  173. ENDDO
  174. C
  175. SEGDES MPOVSU
  176. SEGDES MPOVNO
  177. SEGDES MPOVMR
  178. SEGDES MELFP
  179. C
  180. SEGDES MELFL
  181. SEGSUP MLENTI
  182. C
  183. 9999 RETURN
  184. END
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  

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