Télécharger connec.eso

Retour à la liste

Numérotation des lignes :

  1. C CONNEC SOURCE CB215821 16/12/05 21:15:12 9237
  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 VCONMO(IPMODL,IRET)
  58. IF(IRET.EQ.0) RETURN
  59. C
  60. C LECTURE DU FLOTTANT ...
  61. C
  62. CALL LIRREE(XLONG,0,IRET)
  63. C
  64. C ... OU D'UN 'MCHAML' SOUS TYPE CHARACTERISTIQUE AUX PT DE GAUSS
  65. C
  66. IXLONG=0
  67. IF(IRET.EQ.0) THEN
  68. CALL LIROBJ('MCHAML',IPIN,1,IRET)
  69. IF(IRET.EQ.0) RETURN
  70. CALL REDUAF(IPIN,IPMODL,IXLONG,0,IR,KER)
  71. IF(IR .NE. 1) CALL ERREUR(KER)
  72. IF(IERR .NE. 0) RETURN
  73. CALL PLACHA(IXLONG,TT,1,IRET)
  74. IF(IRET.EQ.0) RETURN
  75. CALL QUESUP (IPMODL,IXLONG,5,1,IRET,IRET2)
  76. IF(IRET.NE.0) RETURN
  77. ENDIF
  78. C
  79. C LECTURE DU MOT CLE ET ACTION SPECIFIQUE RELATIVE
  80. C
  81. ICLE=0
  82. CALL LIRMOT(MCLE,NCLE,ICLE,1)
  83. IF(ICLE.EQ.0) RETURN
  84. C
  85. GOTO(10,20,30,40,50),ICLE
  86. C
  87. C OPTION NORMALE
  88. C
  89. 10 CONTINUE
  90. CALL LIRCHA(CONM,0,IRET)
  91. GOTO 100
  92. C
  93. C OPTION TRANS
  94. C
  95. 20 CONTINUE
  96. CALL LIROBJ('POINT ',JPT1,1,IRET)
  97. IF(IRET.EQ.0) RETURN
  98. CALL LIRCHA(CONM,1,IRET)
  99. IF(IRET.EQ.0) RETURN
  100. GOTO 100
  101. C
  102. C OPTION POINT
  103. C
  104. 30 CONTINUE
  105. CALL LIROBJ('POINT ',JPT1,1,IRET)
  106. IF(IRET.EQ.0) RETURN
  107. CALL LIRCHA(CONM,1,IRET)
  108. IF(IRET.EQ.0) RETURN
  109. GOTO 100
  110. C
  111. C OPTION DROITE
  112. C
  113. 40 CONTINUE
  114. CALL LIROBJ('POINT ',JPT1,1,IRET)
  115. IF(IRET.EQ.0) RETURN
  116. CALL LIROBJ('POINT ',JPT2,1,IRET)
  117. IF(IRET.EQ.0) RETURN
  118. CALL LIRCHA(CONM,1,IRET)
  119. IF(IRET.EQ.0) RETURN
  120. GOTO 100
  121. C
  122. C OPTION PLAN
  123. C
  124. 50 CONTINUE
  125. IF(IDIM.NE.3)THEN
  126. CALL ERREUR(752)
  127. RETURN
  128. ENDIF
  129. CALL LIROBJ('POINT ',JPT1,1,IRET)
  130. IF(IRET.EQ.0) RETURN
  131. CALL LIROBJ('POINT ',JPT2,1,IRET)
  132. IF(IRET.EQ.0) RETURN
  133. CALL LIROBJ('POINT ',JPT3,1,IRET)
  134. IF(IRET.EQ.0) RETURN
  135. CALL LIRCHA(CONM,1,IRET)
  136. IF(IRET.EQ.0) RETURN
  137. GOTO 100
  138. C
  139. C NOM DU CONSTITUANT
  140. C
  141. 100 CONTINUE
  142. IF(IRET.GT.12)GOTO 999
  143. CONSTI=' '
  144. IF(IRET.NE.0) CONSTI(1:IRET)=CONM(1:IRET)
  145. CONSTI(13:16)=MCLE(ICLE)
  146. C
  147. C CALCUL EFFECTIF
  148. C
  149. CALL CONNE1(IPMODL,XLONG,IXLONG,CONSTI,ICLE,JPT1,JPT2,JPT3,
  150. > IPCHCO,IRET)
  151. C
  152. C ECRITURE DU MCHAML
  153. C
  154. IF(IRET.EQ.1) THEN
  155. CALL ECROBJ('MCHAML',IPCHCO)
  156. IF (IIMPI.EQ.2)CALL LLISTE(IPCHCO)
  157. ENDIF
  158. C
  159. RETURN
  160. C----------------ERREURS------------------------------------------
  161. 999 CONTINUE
  162. CALL ERREUR(751)
  163. RETURN
  164. END
  165.  
  166.  
  167.  

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