Télécharger ricol2.eso

Retour à la liste

Numérotation des lignes :

  1. C RICOL2 SOURCE PV 17/09/29 21:15:49 9578
  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. xmatri.symre=2
  94. ITYPEL=28
  95. NBNO=0
  96.  
  97.  
  98. c======================================================================c
  99. C BOUCLE SUR LES CHPOINTS : J=1..NJ
  100.  
  101. SEGACT,MLCHPO
  102. NJ=ICHPOI(/1)
  103. IF(NJ.NE.nve) THEN
  104. write(ioimp,*) 'DIMENSION DU LISTCHPO INCOHERENTE AVEC LA ',
  105. & 'DESCRIPTION DES INCONNUES CONTENUE DANS LA RIGIDITE !'
  106. write(ioimp,*) NJ,nve
  107. CALL ERREUR(21)
  108. RETURN
  109. ENDIF
  110. J=0
  111. 200 J = J + 1
  112. MCHPOI=ICHPOI(J)
  113. SEGACT,MCHPOI
  114.  
  115. c on ouvre tout dans ce chpoint
  116. NSOUPO=IPCHP(/1)
  117. DO 220 ISOUPO=1,NSOUPO
  118. MSOUPO = IPCHP(ISOUPO)
  119. SEGACT,MSOUPO
  120. IPT1 = IGEOC
  121. MPOVAL = IPOVAL
  122. SEGACT,IPT1,MPOVAL
  123. c WRITE(*,*) '1>>>>>>>1comp',MPOVAL.VPOCHA(1,1)
  124. IF(J.NE.1) GOTO 220
  125. IF(ISOUPO.EQ.1) THEN
  126. IRIGEL(5,1) = NOHARM
  127. ELSEIF(IRIGEL(5,1).NE.NOHARM) THEN
  128. WRITE(IOIMP,*) 'CHPOINT AUX HARMONIQUES MULTIPLES NON TRAITES'
  129. CALL ERREUR(21)
  130. RETURN
  131. ENDIF
  132. 220 CONTINUE
  133.  
  134.  
  135. c======================================================================c
  136. C BOUCLE SUR LES INCONNUES DU CHPOINT : I=1..nve
  137.  
  138. DO 400 I=1,nve
  139.  
  140. c recup de la zone
  141. iz = NUMZON(I)
  142. MSOUPO = IPCHP(iz)
  143. IPT1 = IGEOC
  144. MPOVAL = IPOVAL
  145.  
  146. c inconnue : nom + numero
  147. IC = NUINLO(I)
  148. I1 = NUNOLO(I)
  149.  
  150. c ce noeud a t'il deja été vu ?
  151. IP1 = IPT1.NUM(1,I1)
  152. IF(IDEJVU(IP1).EQ.0) THEN
  153. NBNO = NBNO + 1
  154. IDEJVU(IP1) = NBNO
  155. c si non, remplissage de MELEME
  156. NUM(NBNO,1) = IP1
  157. INO1 = NBNO
  158. ELSE
  159. INO1 = IDEJVU(IP1)
  160. ENDIF
  161.  
  162. c remplissage de DESCR (seulement au 1er passage)
  163. IF(J.EQ.1) THEN
  164. LISINC(I) = NAMINC(iz,IC)
  165. LISDUA(I) = NAMDUA(iz,IC)
  166. NOELEP(I) = INO1
  167. NOELED(I) = INO1
  168. ENDIF
  169.  
  170. c remplissage de XMATRI.RE
  171. RE(I,J,1) = VPOCHA(I1,IC)
  172.  
  173. 400 CONTINUE
  174.  
  175.  
  176. c on ferme tout dans ce chpoint
  177. DO 290 ISOUPO=1,NSOUPO
  178. MSOUPO = IPCHP(ISOUPO)
  179. IPT1 = IGEOC
  180. MPOVAL = IPOVAL
  181. SEGDES,IPT1,MPOVAL
  182. SEGDES,MSOUPO
  183. 290 CONTINUE
  184. SEGDES,MCHPOI
  185.  
  186.  
  187. IF(J.LT.NJ) GOTO 200
  188. C FIN DE BOUCLE SUR LES CHPOINTS
  189. c======================================================================c
  190. SEGDES,MLCHPO
  191.  
  192.  
  193. c***********************************************************************
  194. C Normal termination
  195. c***********************************************************************
  196. NBNN=NBNO
  197. SEGADJ,MELEME
  198. SEGDES,MELEME,DESCR,XMATRI
  199. SEGDES,MRIGID,MVECRI
  200. SEGSUP,IDEJVU
  201.  
  202. RETURN
  203.  
  204.  
  205. c***********************************************************************
  206. c End of subroutine
  207. c***********************************************************************
  208.  
  209. END
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  

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