Télécharger ricol2.eso

Retour à la liste

Numérotation des lignes :

  1. C RICOL2 SOURCE BP208322 14/12/17 21:15:07 8323
  2. C
  3. C
  4. SUBROUTINE RICOL2(MLCHPO,ICLE,MRIGID,IVEC1)
  5.  
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8.  
  9. C***********************************************************************
  10. C NOM : RICOL2
  11. C DESCRIPTION : Transforme les CHPOINTs d'un LISTCHPO en matrice colonne
  12. c pleine MRIGID via un modele d'inconnu de IPRIG1
  13. C En pratique on fait une matrice pleine avec l'ordre des
  14. C inconnues contenues dans le mvecri de la rigidite modele
  15. C IPRIG1
  16. C LANGAGE : ESOPE
  17. C
  18. C AUTEUR, DATE, MODIF :
  19. C 02/07/2014, Benoit Prabel : creation
  20. C
  21. C ... merci de compléter les evolutions futures ...
  22. C
  23. C***********************************************************************
  24. C ENTREES : MLCHPO, IPRIG1 (+ autres lectures internes a ricolo)
  25. C ENTREES/SORTIES :
  26. C SORTIES : MRIGID
  27. C***********************************************************************
  28.  
  29. -INC CCOPTIO
  30. -INC SMRIGID
  31. -INC SMCHPOI
  32. -INC SMELEME
  33. -INC SMLCHPO
  34. -INC SMCOORD
  35.  
  36. SEGMENT IDEJVU(NVU)
  37. CHARACTER*4 MOMOT(1)
  38. CHARACTER*8 LETYPE
  39. DATA MOMOT(1) /'TYPE'/
  40.  
  41. c***********************************************************************
  42. c Executable statements
  43. c***********************************************************************
  44.  
  45.  
  46. c======================================================================c
  47. c PRELIMINAIRES
  48.  
  49. IDIM1=IDIM+1
  50. SEGACT MCOORD
  51. NBPTS=XCOOR(/1)/IDIM1
  52. c segment pour ne traiter qu'une seule fois chaque point
  53. NVU=NBPTS
  54. SEGINI,IDEJVU
  55.  
  56. c======================================================================c
  57. c CREATION DE LA RIGIDITE DE SORTIE DEPUIS LE MVECRI D ENTREE
  58.  
  59. NRIGEL=1
  60. SEGINI,MRIGID
  61.  
  62. * -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER --
  63. ITYP = 0
  64. CALL LIRMOT(MOMOT,1,ITYP,0)
  65. IF(ITYP.EQ.1) THEN
  66. ICODE = 1
  67. CALL LIRCHA (LETYPE,ICODE,IRETOU)
  68. IF (IERR .NE. 0) RETURN
  69. ELSE
  70. C ... Si on n'a rien trouvé, on met un sous type par defaut dedans
  71. LETYPE='MONODROM'
  72. ENDIF
  73. MTYMAT=LETYPE
  74.  
  75. COERIG(1)=1.D0
  76.  
  77. c creation des objets depuis le mvecri
  78. MVECRI=IVEC1
  79. SEGACT,MVECRI
  80. nve=NUMZON(/1)
  81. NLIGRP=nve
  82. NLIGRD=nve
  83. NELRIG=1
  84. NBNN=nve
  85. NBELEM=1
  86. NBSOUS=0
  87. NBREF=0
  88. SEGINI,MELEME,DESCR,XMATRI
  89. IRIGEL(1,1)=MELEME
  90. IRIGEL(3,1)=DESCR
  91. IRIGEL(4,1)=XMATRI
  92. IRIGEL(7,1)=2
  93. ITYPEL=28
  94. NBNO=0
  95.  
  96.  
  97. c======================================================================c
  98. C BOUCLE SUR LES CHPOINTS : J=1..NJ
  99.  
  100. SEGACT,MLCHPO
  101. NJ=ICHPOI(/1)
  102. IF(NJ.NE.nve) THEN
  103. write(ioimp,*) 'DIMENSION DU LISTCHPO INCOHERENTE AVEC LA ',
  104. & 'DESCRIPTION DES INCONNUES CONTENUE DANS LA RIGIDITE !'
  105. write(ioimp,*) NJ,nve
  106. CALL ERREUR(21)
  107. RETURN
  108. ENDIF
  109. J=0
  110. 200 J = J + 1
  111. MCHPOI=ICHPOI(J)
  112. SEGACT,MCHPOI
  113.  
  114. c on ouvre tout dans ce chpoint
  115. NSOUPO=IPCHP(/1)
  116. DO 220 ISOUPO=1,NSOUPO
  117. MSOUPO = IPCHP(ISOUPO)
  118. SEGACT,MSOUPO
  119. IPT1 = IGEOC
  120. MPOVAL = IPOVAL
  121. SEGACT,IPT1,MPOVAL
  122. c WRITE(*,*) '1>>>>>>>1comp',MPOVAL.VPOCHA(1,1)
  123. IF(J.NE.1) GOTO 220
  124. IF(ISOUPO.EQ.1) THEN
  125. IRIGEL(5,1) = NOHARM
  126. ELSEIF(IRIGEL(5,1).NE.NOHARM) THEN
  127. WRITE(IOIMP,*) 'CHPOINT AUX HARMONIQUES MULTIPLES NON TRAITES'
  128. CALL ERREUR(21)
  129. RETURN
  130. ENDIF
  131. 220 CONTINUE
  132.  
  133.  
  134. c======================================================================c
  135. C BOUCLE SUR LES INCONNUES DU CHPOINT : I=1..nve
  136.  
  137. DO 400 I=1,nve
  138.  
  139. c recup de la zone
  140. iz = NUMZON(I)
  141. MSOUPO = IPCHP(iz)
  142. IPT1 = IGEOC
  143. MPOVAL = IPOVAL
  144.  
  145. c inconnue : nom + numero
  146. IC = NUINLO(I)
  147. I1 = NUNOLO(I)
  148.  
  149. c ce noeud a t'il deja été vu ?
  150. IP1 = IPT1.NUM(1,I1)
  151. IF(IDEJVU(IP1).EQ.0) THEN
  152. NBNO = NBNO + 1
  153. IDEJVU(IP1) = NBNO
  154. c si non, remplissage de MELEME
  155. NUM(NBNO,1) = IP1
  156. INO1 = NBNO
  157. ELSE
  158. INO1 = IDEJVU(IP1)
  159. ENDIF
  160.  
  161. c remplissage de DESCR (seulement au 1er passage)
  162. IF(J.EQ.1) THEN
  163. LISINC(I) = NAMINC(iz,IC)
  164. LISDUA(I) = NAMDUA(iz,IC)
  165. NOELEP(I) = INO1
  166. NOELED(I) = INO1
  167. ENDIF
  168.  
  169. c remplissage de XMATRI.RE
  170. RE(I,J,1) = VPOCHA(I1,IC)
  171.  
  172. 400 CONTINUE
  173.  
  174.  
  175. c on ferme tout dans ce chpoint
  176. DO 290 ISOUPO=1,NSOUPO
  177. MSOUPO = IPCHP(ISOUPO)
  178. IPT1 = IGEOC
  179. MPOVAL = IPOVAL
  180. SEGDES,IPT1,MPOVAL
  181. SEGDES,MSOUPO
  182. 290 CONTINUE
  183. SEGDES,MCHPOI
  184.  
  185.  
  186. IF(J.LT.NJ) GOTO 200
  187. C FIN DE BOUCLE SUR LES CHPOINTS
  188. c======================================================================c
  189. SEGDES,MLCHPO
  190.  
  191.  
  192. c***********************************************************************
  193. C Normal termination
  194. c***********************************************************************
  195. NBNN=NBNO
  196. SEGADJ,MELEME
  197. SEGDES,MELEME,DESCR,XMATRI
  198. SEGDES,MRIGID,MVECRI
  199. SEGSUP,IDEJVU
  200.  
  201. RETURN
  202.  
  203.  
  204. c***********************************************************************
  205. c End of subroutine
  206. c***********************************************************************
  207.  
  208. END
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  

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