Télécharger ricol2.eso

Retour à la liste

Numérotation des lignes :

ricol2
  1. C RICOL2 SOURCE GOUNAND 25/05/05 21:15:08 12259
  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.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMRIGID
  33. -INC SMCHPOI
  34. -INC SMELEME
  35. -INC SMLCHPO
  36. -INC SMCOORD
  37.  
  38. SEGMENT IDEJVU(NVU)
  39. CHARACTER*4 MOMOT(1)
  40. CHARACTER*8 LETYPE
  41. DATA MOMOT(1) /'TYPE'/
  42.  
  43. c***********************************************************************
  44. c Executable statements
  45. c***********************************************************************
  46.  
  47. c======================================================================c
  48. c PRELIMINAIRES
  49.  
  50. IDIM1=IDIM+1
  51. c segment pour ne traiter qu'une seule fois chaque point
  52. NVU=NBPTS
  53. SEGINI,IDEJVU
  54.  
  55. c======================================================================c
  56. c CREATION DE LA RIGIDITE DE SORTIE DEPUIS LE MVECRI D ENTREE
  57.  
  58. NRIGEL=1
  59. SEGINI,MRIGID
  60.  
  61. * -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER --
  62. ITYP = 0
  63. CALL LIRMOT(MOMOT,1,ITYP,0)
  64. IF(ITYP.EQ.1) THEN
  65. ICODE = 1
  66. CALL LIRCHA (LETYPE,ICODE,IRETOU)
  67. IF (IERR .NE. 0) RETURN
  68. ELSE
  69. C ... Si on n'a rien trouvé, on met un sous type par defaut dedans
  70. LETYPE='MONODROM'
  71. ENDIF
  72. MTYMAT=LETYPE
  73.  
  74. COERIG(1)=1.D0
  75.  
  76. c creation des objets depuis le mvecri
  77. MVECRI=IVEC1
  78. SEGACT,MVECRI
  79. nve=NUMZON(/1)
  80. NLIGRP=nve
  81. NLIGRD=nve
  82. NELRIG=1
  83. NBNN=nve
  84. NBELEM=1
  85. NBSOUS=0
  86. NBREF=0
  87. SEGINI,MELEME,DESCR,XMATRI
  88. IRIGEL(1,1)=MELEME
  89. IRIGEL(3,1)=DESCR
  90. IRIGEL(4,1)=XMATRI
  91. IRIGEL(7,1)=2
  92. xmatri.symre=2
  93. ITYPEL=28
  94. NBNO=0
  95.  
  96. c======================================================================c
  97. C BOUCLE SUR LES CHPOINTS : J=1..NJ
  98.  
  99. SEGACT,MLCHPO
  100. NJ=ICHPOI(/1)
  101. IF(NJ.NE.nve) THEN
  102. write(ioimp,*) 'DIMENSION DU LISTCHPO INCOHERENTE AVEC LA ',
  103. & 'DESCRIPTION DES INCONNUES CONTENUE DANS LA RIGIDITE !'
  104. write(ioimp,*) NJ,nve
  105. CALL ERREUR(21)
  106. RETURN
  107. ENDIF
  108. iforie = -99
  109. DO J = 1, NJ
  110. MCHPOI=ICHPOI(J)
  111. SEGACT,MCHPOI
  112. if (j.eq.1) then
  113. iforie = mchpoi.ifopoi
  114. MRIGID.IFORIG = iforie
  115. else
  116. if (iforie .NE. mchpoi.ifopoi) then
  117. moterr(1:8)='CHPOINT'
  118. interr(1)=iforie
  119. interr(2)=mchpoi.ifopoi
  120. interr(3)=IFOUR
  121. c-dbg write(ioimp,*) '1132 RICOL2',iforie,ifopoi
  122. call erreur(1132)
  123. iforie = IFOUR
  124. MRIGID.IFORIG = iforie
  125. end if
  126. end if
  127.  
  128. c on ouvre tout dans ce chpoint
  129. NSOUPO=IPCHP(/1)
  130. DO 220 ISOUPO=1,NSOUPO
  131. MSOUPO = IPCHP(ISOUPO)
  132. SEGACT,MSOUPO
  133. IPT1 = IGEOC
  134. MPOVAL = IPOVAL
  135. SEGACT,IPT1,MPOVAL
  136. c WRITE(*,*) '1>>>>>>>1comp',MPOVAL.VPOCHA(1,1)
  137. IF(J.NE.1) GOTO 220
  138. IF(ISOUPO.EQ.1) THEN
  139. IRIGEL(5,1) = NOHARM
  140. ELSEIF(IRIGEL(5,1).NE.NOHARM) THEN
  141. WRITE(IOIMP,*) 'CHPOINT AUX HARMONIQUES MULTIPLES NON TRAITES'
  142. CALL ERREUR(21)
  143. RETURN
  144. ENDIF
  145. 220 CONTINUE
  146.  
  147.  
  148. c======================================================================c
  149. C BOUCLE SUR LES INCONNUES DU CHPOINT : I=1..nve
  150.  
  151. DO 400 I=1,nve
  152.  
  153. c recup de la zone
  154. iz = NUMZON(I)
  155. MSOUPO = IPCHP(iz)
  156. IPT1 = IGEOC
  157. MPOVAL = IPOVAL
  158.  
  159. c inconnue : nom + numero
  160. IC = NUINLO(I)
  161. I1 = NUNOLO(I)
  162.  
  163. c ce noeud a t'il deja été vu ?
  164. IP1 = IPT1.NUM(1,I1)
  165. IF(IDEJVU(IP1).EQ.0) THEN
  166. NBNO = NBNO + 1
  167. IDEJVU(IP1) = NBNO
  168. c si non, remplissage de MELEME
  169. NUM(NBNO,1) = IP1
  170. INO1 = NBNO
  171. ELSE
  172. INO1 = IDEJVU(IP1)
  173. ENDIF
  174.  
  175. c remplissage de DESCR (seulement au 1er passage)
  176. IF(J.EQ.1) THEN
  177. LISINC(I) = NAMINC(iz,IC)
  178. LISDUA(I) = NAMDUA(iz,IC)
  179. NOELEP(I) = INO1
  180. NOELED(I) = INO1
  181. ENDIF
  182.  
  183. c remplissage de XMATRI.RE
  184. RE(I,J,1) = VPOCHA(I1,IC)
  185.  
  186. 400 CONTINUE
  187.  
  188.  
  189. c on ferme tout dans ce chpoint
  190. DO 290 ISOUPO=1,NSOUPO
  191. MSOUPO = IPCHP(ISOUPO)
  192. IPT1 = IGEOC
  193. MPOVAL = IPOVAL
  194. SEGDES,IPT1,MPOVAL
  195. SEGDES,MSOUPO
  196. 290 CONTINUE
  197. SEGDES,MCHPOI
  198.  
  199. END DO
  200. C FIN DE BOUCLE SUR LES CHPOINTS
  201. c======================================================================c
  202. SEGDES,MLCHPO
  203.  
  204. c***********************************************************************
  205. C Normal termination
  206. c***********************************************************************
  207. NBNN=NBNO
  208. SEGADJ,MELEME
  209. SEGDES,MELEME,DESCR,XMATRI
  210. SEGDES,MRIGID,MVECRI
  211. SEGSUP,IDEJVU
  212.  
  213. RETURN
  214. c***********************************************************************
  215. c End of subroutine
  216. c***********************************************************************
  217.  
  218. END
  219.  
  220.  

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