Télécharger ricol1.eso

Retour à la liste

Numérotation des lignes :

  1. C RICOL1 SOURCE BP208322 14/12/17 21:15:06 8323
  2. C
  3. C
  4. SUBROUTINE RICOL1(MLCHPO,ICLE,MRIGID,IPT1)
  5.  
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8.  
  9. C***********************************************************************
  10. C NOM : RICOL1
  11. C DESCRIPTION : Transforme les CHPOINTs d'un LISTCHPO en matrice colonne
  12. c pleine MRIGID avec les inconnues modales ALFA-FALF
  13. C et un maillage de POI1
  14. C LANGAGE : ESOPE
  15. C
  16. C AUTEUR, DATE, MODIF :
  17. C 16/12/2014, Benoit Prabel : creation
  18. C
  19. C ... merci de compléter les evolutions futures ...
  20. C
  21. C***********************************************************************
  22. C ENTREES : MLCHPO, IPT1 (+ autres lectures internes a ricolo)
  23. C ENTREES/SORTIES :
  24. C SORTIES : MRIGID
  25. C***********************************************************************
  26.  
  27. -INC CCOPTIO
  28. -INC SMRIGID
  29. -INC SMCHPOI
  30. -INC SMELEME
  31. -INC SMLCHPO
  32. -INC SMCOORD
  33.  
  34. CHARACTER*4 MOMOT(1)
  35. CHARACTER*8 LETYPE
  36. DATA MOMOT(1) /'TYPE'/
  37.  
  38. c***********************************************************************
  39. c Executable statements
  40. c***********************************************************************
  41.  
  42.  
  43. c======================================================================c
  44. c PRELIMINAIRES
  45.  
  46.  
  47. c======================================================================c
  48. c CREATION DE LA RIGIDITE DE SORTIE DEPUIS LE MELEME D ENTREE
  49.  
  50. NRIGEL=1
  51. SEGINI,MRIGID
  52.  
  53. * -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER --
  54. ITYP = 0
  55. CALL LIRMOT(MOMOT,1,ITYP,0)
  56. IF(ITYP.EQ.1) THEN
  57. ICODE = 1
  58. CALL LIRCHA (LETYPE,ICODE,IRETOU)
  59. IF (IERR .NE. 0) RETURN
  60. ELSE
  61. C ... Si on n'a rien trouvé, on met un sous type par defaut dedans
  62. LETYPE='MONODROM'
  63. ENDIF
  64. MTYMAT=LETYPE
  65.  
  66. COERIG(1)=1.D0
  67.  
  68. C -- CREATION DES OBJETS DEPUIS IPT1 --
  69. SEGACT,IPT1
  70. c verif qu il s'agit dun maillage de POI1
  71. NBSOUS=IPT1.LISOUS(/1)
  72. IF(NBSOUS.NE.0) THEN
  73. WRITE(IOIMP,*) 'Maillage simple de POI1 attendu en entrée !'
  74. CALL ERREUR(25)
  75. RETURN
  76. ENDIF
  77. NBNN =IPT1.NUM(/1)
  78. NBELEM=IPT1.NUM(/2)
  79. ITYP1 =IPT1.ITYPEL
  80. IF(NBNN.NE.1.OR.ITYP1.NE.1) THEN
  81. WRITE(IOIMP,*) NBNN,NBELEM,' element de type ',ITYP1
  82. WRITE(IOIMP,*) 'Maillage de POI1 attendu en entrée !'
  83. CALL ERREUR(16)
  84. RETURN
  85. ENDIF
  86. c creation des MELEME,DESCR,XMATRI de la mrigid de sortie
  87. NLIGRP=NBELEM
  88. NLIGRD=NBELEM
  89. NELRIG=1
  90. NBNN=NBELEM
  91. NBELEM=1
  92. NBSOUS=0
  93. NBREF=0
  94. SEGINI,MELEME,DESCR,XMATRI
  95. IRIGEL(1,1)=MELEME
  96. IRIGEL(3,1)=DESCR
  97. IRIGEL(4,1)=XMATRI
  98. IRIGEL(7,1)=2
  99. * on prend le type SUPERELEMENT a defaut d'autre chose...
  100. ITYPEL=28
  101. NBNO=0
  102. DO I=1,NBNN
  103. NUM(I,1)=IPT1.NUM(1,I)
  104. LISINC(I)='ALFA'
  105. LISDUA(I)='FALF'
  106. NOELEP(I)=I
  107. NOELED(I)=I
  108. ENDDO
  109. SEGDES,IPT1,DESCR
  110.  
  111.  
  112. c======================================================================c
  113. C BOUCLE SUR LES CHPOINTS : J=1..NJ
  114.  
  115. SEGACT,MLCHPO
  116. NJ=ICHPOI(/1)
  117. IF(NJ.NE.NBNN) THEN
  118. write(ioimp,*) 'DIMENSION DU LISTCHPO INCOHERENTE AVEC LA ',
  119. & 'DESCRIPTION DES INCONNUES CONTENUE DANS LA RIGIDITE !'
  120. write(ioimp,*) NJ,NBNN
  121. CALL ERREUR(21)
  122. RETURN
  123. ENDIF
  124. J=0
  125. 200 J = J + 1
  126. MCHPOI=ICHPOI(J)
  127. SEGACT,MCHPOI
  128.  
  129. c on ouvre tout dans ce chpoint
  130. NSOUPO=IPCHP(/1)
  131. IF(NSOUPO.NE.1) THEN
  132. WRITE(IOIMP,*) 'LE CHPOINT DOIT AVOIR 1 SEULE ZONE !'
  133. CALL ERREUR(21)
  134. RETURN
  135. ENDIF
  136. ISOUPO=1
  137. MSOUPO = IPCHP(ISOUPO)
  138. SEGACT,MSOUPO
  139. NC=NOCOMP(/2)
  140. IF(NC.NE.1.OR.NOCOMP(1).NE.'ALFA') THEN
  141. WRITE(IOIMP,*) 'LE CHPOINT DOIT AVOIR 1 COMPOSANTE : ALFA !'
  142. CALL ERREUR(21)
  143. RETURN
  144. ENDIF
  145. IPT1 = IGEOC
  146. MPOVAL = IPOVAL
  147. SEGACT,IPT1,MPOVAL
  148. c WRITE(*,*) '1>>>>>>>1comp',MPOVAL.VPOCHA(1,1)
  149. IF(J.NE.1) GOTO 220
  150. c IF(ISOUPO.EQ.1) THEN
  151. IRIGEL(5,1) = NOHARM
  152. c ELSEIF(IRIGEL(5,1).NE.NOHARM) THEN
  153. c WRITE(IOIMP,*) 'CHPOINT AUX HARMONIQUES MULTIPLES NON TRAITES'
  154. c CALL ERREUR(21)
  155. c RETURN
  156. c ENDIF
  157. 220 CONTINUE
  158.  
  159.  
  160. c======================================================================c
  161. C BOUCLE SUR LES points DU CHPOINT : I=1..N
  162.  
  163. N=VPOCHA(/1)
  164. DO 400 I=1,N
  165.  
  166. c recup du noeud
  167. inode = IPT1.NUM(1,i)
  168. c recherche de la position du noeud dans le MELEME de la rigidite
  169. DO ii=1,NBNN
  170. IF(NUM(ii,1).EQ.inode) GOTO 411
  171. ENDDO
  172. WRITE(IOIMP,*) 'Noeud',inode,'absent dans le MAILLAGE d entree'
  173. CALL ERREUR(21)
  174. RETURN
  175.  
  176. 411 CONTINUE
  177. c remplissage de XMATRI.RE
  178. RE(ii,J,1) = VPOCHA(I,1)
  179.  
  180. 400 CONTINUE
  181.  
  182.  
  183. c on ferme tout dans ce chpoint
  184. DO 290 ISOUPO=1,NSOUPO
  185. MSOUPO = IPCHP(ISOUPO)
  186. IPT1 = IGEOC
  187. MPOVAL = IPOVAL
  188. SEGDES,IPT1,MPOVAL
  189. SEGDES,MSOUPO
  190. 290 CONTINUE
  191. SEGDES,MCHPOI
  192.  
  193.  
  194. IF(J.LT.NJ) GOTO 200
  195. C FIN DE BOUCLE SUR LES CHPOINTS
  196. c======================================================================c
  197. SEGDES,MLCHPO
  198.  
  199.  
  200. c***********************************************************************
  201. C Normal termination
  202. c***********************************************************************
  203. SEGDES,MELEME,XMATRI
  204. SEGDES,MRIGID
  205.  
  206. RETURN
  207.  
  208.  
  209. c***********************************************************************
  210. c End of subroutine
  211. c***********************************************************************
  212.  
  213. END
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  

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