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.  
  62. -INC PPARAM
  63. -INC CCOPTIO
  64. -INC SMELEME
  65. POINTEUR MELFL.MELEME,MELFP.MELEME,MELF.MELEME
  66. -INC SMCHPOI
  67. POINTEUR MPOVSU.MPOVAL, MPOVNO.MPOVAL, MPOVMR.MPOVAL
  68. -INC SMLENTI
  69. -INC SMLMOTS
  70. -INC SMCOORD
  71. C
  72. C**** Corresp. FACE
  73. C
  74. CALL KRIPAD(MELF,MLENTI)
  75. C SEGINI MLENTI
  76. C
  77. C**** Champoint surfaces
  78. C
  79. JGN=4
  80. JGM=1
  81. SEGINI MLMOTS
  82. MLMOTS.MOTS(1)='SCAL'
  83. TYPE='FACE '
  84. CALL KRCHP1(TYPE,MELF,MCHPSU,MLMOTS)
  85. IF(IERR.NE.0)GOTO 9999
  86. CALL LICHT(MCHPSU,MPOVSU,TYPE,IGEOM)
  87. IF(IERR.NE.0)GOTO 9999
  88. C SEGACT MPOVSU
  89. SEGSUP MLMOTS
  90. C
  91. C**** Champoint normales
  92. C
  93. JGN=4
  94. JGM=IDIM
  95. SEGINI MLMOTS
  96. MLMOTS.MOTS(1)='UX'
  97. MLMOTS.MOTS(2)='UY'
  98. TYPE='FACE '
  99. CALL KRCHP1(TYPE,MELF,MCHPNO,MLMOTS)
  100. IF(IERR.NE.0)GOTO 9999
  101. CALL LICHT(MCHPNO,MPOVNO,TYPE,IGEOM)
  102. IF(IERR.NE.0)GOTO 9999
  103. C SEGACT MPOVNO
  104. SEGSUP MLMOTS
  105. C
  106. C**** Champoint matrice de rotation
  107. C
  108. JGN=4
  109. JGM=IDIM*IDIM
  110. SEGINI MLMOTS
  111. C IF(IDIM.EQ.2)THEN
  112. MLMOTS.MOTS(1)='RX'
  113. MLMOTS.MOTS(2)='RY'
  114. MLMOTS.MOTS(3)='MX'
  115. MLMOTS.MOTS(4)='MY'
  116. * Normale en M
  117. * vect(M,U) = z
  118. C ENDIF
  119. CALL KRCHP1(TYPE,MELF,MCHPMR,MLMOTS)
  120. IF(IERR.NE.0)GOTO 9999
  121. CALL LICHT(MCHPMR,MPOVMR,TYPE,IGEOM)
  122. IF(IERR.NE.0)GOTO 9999
  123. C SEGACT MPOVMR
  124. C
  125. SEGACT MELFP
  126. C In the case 2D, NBSOUS=1
  127. SEGACT MELFL
  128. C
  129. NP=MELFP.NUM(/1)-1
  130. NEL=MELFP.NUM(/2)
  131. IF(NP .NE. 2)THEN
  132. WRITE(IOIMP,*) 'Subroutine kdom4c.eso'
  133. CALL ERREUR(5)
  134. ENDIF
  135. C
  136. DO IEL=1,NEL,1
  137. C X1,Y1,X2,Y2,XF,YF
  138. NF=MELFP.NUM(NP+1,IEL)
  139. IP1=MELFP.NUM(1,IEL)
  140. IP2=MELFP.NUM(2,IEL)
  141. X1=XCOOR((IP1-1)*(IDIM+1)+1)
  142. Y1=XCOOR((IP1-1)*(IDIM+1)+2)
  143. X2=XCOOR((IP2-1)*(IDIM+1)+1)
  144. Y2=XCOOR((IP2-1)*(IDIM+1)+2)
  145. CALL KDOM3B(X1,Y1,X2,Y2,SURF,XF,YF)
  146. XCOOR((NF-1)*(IDIM+1)+1)=XF
  147. XCOOR((NF-1)*(IDIM+1)+2)=YF
  148. NLCF=MLENTI.LECT(NF)
  149. MPOVSU.VPOCHA(NLCF,1)=SURF
  150. DX=X1-XF
  151. DY=Y1-YF
  152. DVAL=((DX*DX)+(DY*DY))**0.5D0
  153. DNX=DY/DVAL
  154. DNY=-1.0D0*DX/DVAL
  155. DTX=DX/DVAL
  156. DTY=DY/DVAL
  157. C
  158. C******* Orientation selon FACEL
  159. C
  160. IP1=MELFL.NUM(1,NLCF)
  161. X1=XCOOR((IP1-1)*(IDIM+1)+1)
  162. Y1=XCOOR((IP1-1)*(IDIM+1)+2)
  163. DX=XF-X1
  164. DY=YF-Y1
  165. ORIENT=SIGN(1.0D0,((DNX*DX)+(DNY*DY)))
  166. C
  167. MPOVNO.VPOCHA(NLCF,1)=DNX*ORIENT
  168. MPOVNO.VPOCHA(NLCF,2)=DNY*ORIENT
  169. C
  170. MPOVMR.VPOCHA(NLCF,3)=DNX*ORIENT
  171. MPOVMR.VPOCHA(NLCF,4)=DNY*ORIENT
  172. MPOVMR.VPOCHA(NLCF,1)=DTX*ORIENT
  173. MPOVMR.VPOCHA(NLCF,2)=DTY*ORIENT
  174. C
  175. ENDDO
  176. C
  177. SEGDES MPOVSU
  178. SEGDES MPOVNO
  179. SEGDES MPOVMR
  180. SEGDES MELFP
  181. C
  182. SEGDES MELFL
  183. SEGSUP MLENTI
  184. C
  185. 9999 RETURN
  186. END
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  

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