Télécharger connec.eso

Retour à la liste

Numérotation des lignes :

  1. C CONNEC SOURCE PV 20/03/31 14:33:14 10567
  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.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMCOORD
  33. -INC SMCHAML
  34. CHARACTER*(NCONCH) CONM
  35. C
  36. C IPMODL Pointeur sur un objet MMODEL
  37. C XLONG,IXLONG Longueur caracteristique scalaire ou champ
  38. C JPT1|
  39. C JPT2| pointeurs eventuels sur des objets de type point
  40. C JPT3|
  41. C
  42. C IPCHCO Pointeur sur un MCHAML de Connectivite
  43. C
  44. C LISTE DES MOTS CLE
  45. C
  46. PARAMETER(NCLE=5)
  47. CHARACTER*4 MCLE(NCLE)
  48. DATA MCLE/'NORM','TRAN','POIN','DROI','PLAN'/
  49. C
  50. segact mcoord
  51.  
  52. JPT1=0
  53. JPT2=0
  54. JPT3=0
  55. C
  56. C LECTURE DU MODEL ET VERIFICATION DE SA CONSISTANCE
  57. C (UN SEUL CONSTITUANT, UNE REGION GEOMETRIQUE SIMPLE)
  58. C
  59. CALL LIROBJ('MMODEL ',IPMODL,1,IRET)
  60. CALL ACTOBJ('MMODEL ',IPMODL,1)
  61. IF(IRET.EQ.0) RETURN
  62. CALL VCONMO(IPMODL,IRET)
  63. IF(IRET.EQ.0) RETURN
  64. C
  65. C LECTURE DU FLOTTANT ...
  66. C
  67. CALL LIRREE(XLONG,0,IRET)
  68. C
  69. C ... OU D'UN 'MCHAML' SOUS TYPE CHARACTERISTIQUE AUX PT DE GAUSS
  70. C
  71. IXLONG=0
  72. IF(IRET.EQ.0) THEN
  73. CALL LIROBJ('MCHAML ',IPIN,1,IRET)
  74. CALL ACTOBJ('MCHAML ',IPIN,1)
  75.  
  76. CALL REDUAF(IPIN,IPMODL,IXLONG,0,IR,KER)
  77. IF(IR .NE. 1) CALL ERREUR(KER)
  78. IF(IERR .NE. 0) RETURN
  79. CALL PLACHA(IXLONG,TT,1,IRET)
  80. IF(IRET.EQ.0) RETURN
  81. CALL QUESUP (IPMODL,IXLONG,5,1,IRET,IRET2)
  82. IF(IRET.NE.0) RETURN
  83. ENDIF
  84. C
  85. C LECTURE DU MOT CLE ET ACTION SPECIFIQUE RELATIVE
  86. C
  87. ICLE=0
  88. CALL LIRMOT(MCLE,NCLE,ICLE,1)
  89. IF(ICLE.EQ.0) RETURN
  90. C
  91. GOTO(10,20,30,40,50),ICLE
  92. C
  93. C OPTION NORMALE
  94. C
  95. 10 CONTINUE
  96. CALL LIRCHA(CONM,0,IRET)
  97. GOTO 100
  98. C
  99. C OPTION TRANS
  100. C
  101. 20 CONTINUE
  102. CALL LIROBJ('POINT ',JPT1,1,IRET)
  103. IF(IRET.EQ.0) RETURN
  104. CALL LIRCHA(CONM,1,IRET)
  105. IF(IRET.EQ.0) RETURN
  106. GOTO 100
  107. C
  108. C OPTION POINT
  109. C
  110. 30 CONTINUE
  111. CALL LIROBJ('POINT ',JPT1,1,IRET)
  112. IF(IRET.EQ.0) RETURN
  113. CALL LIRCHA(CONM,1,IRET)
  114. IF(IRET.EQ.0) RETURN
  115. GOTO 100
  116. C
  117. C OPTION DROITE
  118. C
  119. 40 CONTINUE
  120. CALL LIROBJ('POINT ',JPT1,1,IRET)
  121. IF(IRET.EQ.0) RETURN
  122. CALL LIROBJ('POINT ',JPT2,1,IRET)
  123. IF(IRET.EQ.0) RETURN
  124. CALL LIRCHA(CONM,1,IRET)
  125. IF(IRET.EQ.0) RETURN
  126. GOTO 100
  127. C
  128. C OPTION PLAN
  129. C
  130. 50 CONTINUE
  131. IF(IDIM.NE.3)THEN
  132. CALL ERREUR(752)
  133. RETURN
  134. ENDIF
  135. CALL LIROBJ('POINT ',JPT1,1,IRET)
  136. IF(IRET.EQ.0) RETURN
  137. CALL LIROBJ('POINT ',JPT2,1,IRET)
  138. IF(IRET.EQ.0) RETURN
  139. CALL LIROBJ('POINT ',JPT3,1,IRET)
  140. IF(IRET.EQ.0) RETURN
  141. CALL LIRCHA(CONM,1,IRET)
  142. IF(IRET.EQ.0) RETURN
  143. GOTO 100
  144. C
  145. C NOM DU CONSTITUANT
  146. C
  147. 100 CONTINUE
  148. IF(IRET.GT.12)GOTO 999
  149. CONSTI=' '
  150. IF(IRET.NE.0) CONSTI(1:IRET)=CONM(1:IRET)
  151. CONSTI(13:16)=MCLE(ICLE)
  152. C
  153. C CALCUL EFFECTIF
  154. C
  155. CALL CONNE1(IPMODL,XLONG,IXLONG,CONSTI,ICLE,JPT1,JPT2,JPT3,
  156. > IPCHCO,IRET)
  157. C
  158. C ECRITURE DU MCHAML
  159. C
  160. IF(IRET.EQ.1) THEN
  161. CALL ACTOBJ('MCHAML ',IPCHCO,1)
  162. CALL ECROBJ('MCHAML ',IPCHCO)
  163. IF (IIMPI.EQ.2)CALL LLISTE(IPCHCO)
  164. ENDIF
  165. RETURN
  166.  
  167. C----------------ERREURS------------------------------------------
  168. 999 CONTINUE
  169. CALL ERREUR(751)
  170. END
  171.  
  172.  
  173.  
  174.  
  175.  

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