Télécharger ricol1.eso

Retour à la liste

Numérotation des lignes :

  1. C RICOL1 SOURCE PV 17/09/29 21:15:48 9578
  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. xmatri.symre=2
  100. * on prend le type SUPERELEMENT a defaut d'autre chose...
  101. ITYPEL=28
  102. NBNO=0
  103. DO I=1,NBNN
  104. NUM(I,1)=IPT1.NUM(1,I)
  105. LISINC(I)='ALFA'
  106. LISDUA(I)='FALF'
  107. NOELEP(I)=I
  108. NOELED(I)=I
  109. ENDDO
  110. SEGDES,IPT1,DESCR
  111.  
  112.  
  113. c======================================================================c
  114. C BOUCLE SUR LES CHPOINTS : J=1..NJ
  115.  
  116. SEGACT,MLCHPO
  117. NJ=ICHPOI(/1)
  118. IF(NJ.NE.NBNN) THEN
  119. write(ioimp,*) 'DIMENSION DU LISTCHPO INCOHERENTE AVEC LA ',
  120. & 'DESCRIPTION DES INCONNUES CONTENUE DANS LA RIGIDITE !'
  121. write(ioimp,*) NJ,NBNN
  122. CALL ERREUR(21)
  123. RETURN
  124. ENDIF
  125. J=0
  126. 200 J = J + 1
  127. MCHPOI=ICHPOI(J)
  128. SEGACT,MCHPOI
  129.  
  130. c on ouvre tout dans ce chpoint
  131. NSOUPO=IPCHP(/1)
  132. IF(NSOUPO.NE.1) THEN
  133. WRITE(IOIMP,*) 'LE CHPOINT DOIT AVOIR 1 SEULE ZONE !'
  134. CALL ERREUR(21)
  135. RETURN
  136. ENDIF
  137. ISOUPO=1
  138. MSOUPO = IPCHP(ISOUPO)
  139. SEGACT,MSOUPO
  140. NC=NOCOMP(/2)
  141. IF(NC.NE.1.OR.NOCOMP(1).NE.'ALFA') THEN
  142. WRITE(IOIMP,*) 'LE CHPOINT DOIT AVOIR 1 COMPOSANTE : ALFA !'
  143. CALL ERREUR(21)
  144. RETURN
  145. ENDIF
  146. IPT1 = IGEOC
  147. MPOVAL = IPOVAL
  148. SEGACT,IPT1,MPOVAL
  149. c WRITE(*,*) '1>>>>>>>1comp',MPOVAL.VPOCHA(1,1)
  150. IF(J.NE.1) GOTO 220
  151. c IF(ISOUPO.EQ.1) THEN
  152. IRIGEL(5,1) = NOHARM
  153. c ELSEIF(IRIGEL(5,1).NE.NOHARM) THEN
  154. c WRITE(IOIMP,*) 'CHPOINT AUX HARMONIQUES MULTIPLES NON TRAITES'
  155. c CALL ERREUR(21)
  156. c RETURN
  157. c ENDIF
  158. 220 CONTINUE
  159.  
  160.  
  161. c======================================================================c
  162. C BOUCLE SUR LES points DU CHPOINT : I=1..N
  163.  
  164. N=VPOCHA(/1)
  165. DO 400 I=1,N
  166.  
  167. c recup du noeud
  168. inode = IPT1.NUM(1,i)
  169. c recherche de la position du noeud dans le MELEME de la rigidite
  170. DO ii=1,NBNN
  171. IF(NUM(ii,1).EQ.inode) GOTO 411
  172. ENDDO
  173. WRITE(IOIMP,*) 'Noeud',inode,'absent dans le MAILLAGE d entree'
  174. CALL ERREUR(21)
  175. RETURN
  176.  
  177. 411 CONTINUE
  178. c remplissage de XMATRI.RE
  179. RE(ii,J,1) = VPOCHA(I,1)
  180.  
  181. 400 CONTINUE
  182.  
  183.  
  184. c on ferme tout dans ce chpoint
  185. DO 290 ISOUPO=1,NSOUPO
  186. MSOUPO = IPCHP(ISOUPO)
  187. IPT1 = IGEOC
  188. MPOVAL = IPOVAL
  189. SEGDES,IPT1,MPOVAL
  190. SEGDES,MSOUPO
  191. 290 CONTINUE
  192. SEGDES,MCHPOI
  193.  
  194.  
  195. IF(J.LT.NJ) GOTO 200
  196. C FIN DE BOUCLE SUR LES CHPOINTS
  197. c======================================================================c
  198. SEGDES,MLCHPO
  199.  
  200.  
  201. c***********************************************************************
  202. C Normal termination
  203. c***********************************************************************
  204. SEGDES,MELEME,XMATRI
  205. SEGDES,MRIGID
  206.  
  207. RETURN
  208.  
  209.  
  210. c***********************************************************************
  211. c End of subroutine
  212. c***********************************************************************
  213.  
  214. END
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  

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