Télécharger connec.eso

Retour à la liste

Numérotation des lignes :

  1. C CONNEC SOURCE CB215821 18/09/21 21:15:31 9930
  2. SUBROUTINE CONNEC
  3. C_______________________________________________________________________
  4. C
  5. C CALCUL DU MCHAML DES ELEMENTS SE TROUVANT A UNE DISTANCE
  6. C INFERIEURE A XLONG DE CHAQUE ELEMENT DE MMODEL EVENTUELLEMENT
  7. C SYMETRISE OU TRANSLATE.
  8. C
  9. C CHAM1=CONN MODL1 |FLOT1 |'NORMAL' (MOT1);
  10. C |CHAM1 |'POINT' POIN1 MOT1 ;
  11. C |'DROITE' POIN1 POIN2 MOT1 ;
  12. C |'PLAN' POIN1 POIN2 POIN3 MOT1 ;
  13. C |'TRANS' POIN1 MOT1 ;
  14. C APPEL A:
  15. C
  16. C VCONMO : verification de la consistance du modele
  17. C CONNE1 : calcul effectif des connectivites
  18. C LLISTE : impression du champ de connectivite
  19. C LIROBJ, LIRREE, LIRMOT, LIRCHA
  20. C
  21. C AUTEURS P.PEGON 18/11/91 C. LA BORDERIE MARS 92
  22. C P.PEGON 22/10/92
  23. C_______________________________________________________________________
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26. CHARACTER*16 CONSTI
  27. CHARACTER*16 TT
  28. DATA TT/'CARACTERISTIQUES'/
  29. -INC CCOPTIO
  30. -INC SMCOORD
  31. -INC SMCHAML
  32. CHARACTER*(NCONCH) CONM
  33. C
  34. C IPMODL Pointeur sur un objet MMODEL
  35. C XLONG,IXLONG Longueur caracteristique scalaire ou champ
  36. C JPT1|
  37. C JPT2| pointeurs eventuels sur des objets de type point
  38. C JPT3|
  39. C
  40. C IPCHCO Pointeur sur un MCHAML de Connectivite
  41. C
  42. C LISTE DES MOTS CLE
  43. C
  44. PARAMETER(NCLE=5)
  45. CHARACTER*4 MCLE(NCLE)
  46. DATA MCLE/'NORM','TRAN','POIN','DROI','PLAN'/
  47. C
  48. JPT1=0
  49. JPT2=0
  50. JPT3=0
  51. C
  52. C LECTURE DU MODEL ET VERIFICATION DE SA CONSISTANCE
  53. C (UN SEUL CONSTITUANT, UNE REGION GEOMETRIQUE SIMPLE)
  54. C
  55. CALL LIROBJ('MMODEL',IPMODL,1,IRET)
  56. IF(IRET.EQ.0) RETURN
  57. CALL ACTOBJ('MMODEL ',IPMODL,1)
  58. CALL VCONMO(IPMODL,IRET)
  59. IF(IRET.EQ.0) RETURN
  60. C
  61. C LECTURE DU FLOTTANT ...
  62. C
  63. CALL LIRREE(XLONG,0,IRET)
  64. C
  65. C ... OU D'UN 'MCHAML' SOUS TYPE CHARACTERISTIQUE AUX PT DE GAUSS
  66. C
  67. IXLONG=0
  68. IF(IRET.EQ.0) THEN
  69. CALL LIROBJ('MCHAML',IPIN,1,IRET)
  70. IF(IRET.EQ.0) RETURN
  71. CALL ACTOBJ('MCHAML ',IPIN,1)
  72. CALL REDUAF(IPIN,IPMODL,IXLONG,0,IR,KER)
  73. IF(IR .NE. 1) CALL ERREUR(KER)
  74. IF(IERR .NE. 0) RETURN
  75. CALL PLACHA(IXLONG,TT,1,IRET)
  76. IF(IRET.EQ.0) RETURN
  77. CALL QUESUP (IPMODL,IXLONG,5,1,IRET,IRET2)
  78. IF(IRET.NE.0) RETURN
  79. ENDIF
  80. C
  81. C LECTURE DU MOT CLE ET ACTION SPECIFIQUE RELATIVE
  82. C
  83. ICLE=0
  84. CALL LIRMOT(MCLE,NCLE,ICLE,1)
  85. IF(ICLE.EQ.0) RETURN
  86. C
  87. GOTO(10,20,30,40,50),ICLE
  88. C
  89. C OPTION NORMALE
  90. C
  91. 10 CONTINUE
  92. CALL LIRCHA(CONM,0,IRET)
  93. GOTO 100
  94. C
  95. C OPTION TRANS
  96. C
  97. 20 CONTINUE
  98. CALL LIROBJ('POINT ',JPT1,1,IRET)
  99. IF(IRET.EQ.0) RETURN
  100. CALL LIRCHA(CONM,1,IRET)
  101. IF(IRET.EQ.0) RETURN
  102. GOTO 100
  103. C
  104. C OPTION POINT
  105. C
  106. 30 CONTINUE
  107. CALL LIROBJ('POINT ',JPT1,1,IRET)
  108. IF(IRET.EQ.0) RETURN
  109. CALL LIRCHA(CONM,1,IRET)
  110. IF(IRET.EQ.0) RETURN
  111. GOTO 100
  112. C
  113. C OPTION DROITE
  114. C
  115. 40 CONTINUE
  116. CALL LIROBJ('POINT ',JPT1,1,IRET)
  117. IF(IRET.EQ.0) RETURN
  118. CALL LIROBJ('POINT ',JPT2,1,IRET)
  119. IF(IRET.EQ.0) RETURN
  120. CALL LIRCHA(CONM,1,IRET)
  121. IF(IRET.EQ.0) RETURN
  122. GOTO 100
  123. C
  124. C OPTION PLAN
  125. C
  126. 50 CONTINUE
  127. IF(IDIM.NE.3)THEN
  128. CALL ERREUR(752)
  129. RETURN
  130. ENDIF
  131. CALL LIROBJ('POINT ',JPT1,1,IRET)
  132. IF(IRET.EQ.0) RETURN
  133. CALL LIROBJ('POINT ',JPT2,1,IRET)
  134. IF(IRET.EQ.0) RETURN
  135. CALL LIROBJ('POINT ',JPT3,1,IRET)
  136. IF(IRET.EQ.0) RETURN
  137. CALL LIRCHA(CONM,1,IRET)
  138. IF(IRET.EQ.0) RETURN
  139. GOTO 100
  140. C
  141. C NOM DU CONSTITUANT
  142. C
  143. 100 CONTINUE
  144. IF(IRET.GT.12)GOTO 999
  145. CONSTI=' '
  146. IF(IRET.NE.0) CONSTI(1:IRET)=CONM(1:IRET)
  147. CONSTI(13:16)=MCLE(ICLE)
  148. C
  149. C CALCUL EFFECTIF
  150. C
  151. CALL CONNE1(IPMODL,XLONG,IXLONG,CONSTI,ICLE,JPT1,JPT2,JPT3,
  152. > IPCHCO,IRET)
  153. C
  154. C ECRITURE DU MCHAML
  155. C
  156. IF(IRET.EQ.1) THEN
  157. CALL ECROBJ('MCHAML',IPCHCO)
  158. IF (IIMPI.EQ.2)CALL LLISTE(IPCHCO)
  159. ENDIF
  160. C
  161. RETURN
  162. C----------------ERREURS------------------------------------------
  163. 999 CONTINUE
  164. CALL ERREUR(751)
  165. RETURN
  166. END
  167.  
  168.  
  169.  
  170.  

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