Télécharger relr14.eso

Retour à la liste

Numérotation des lignes :

  1. C RELR14 SOURCE GOUNAND 12/08/01 22:29:18 7454
  2. SUBROUTINE RELR14(MLIN,KJSPGP,KJSPGD,LINCP,LINCD,
  3. $ MINCP,MINCD,
  4. $ PROFM,VALM,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : RELR14
  10. C DESCRIPTION :
  11. *
  12. * Construction du profil Morse de la matrice assemblée
  13. * Celui-ci est ordonné (les numeros de colonnes
  14. * dans IA sont en ordre croissant)
  15. *
  16. C
  17. C
  18. C
  19. C LANGAGE : ESOPE
  20. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  21. C mél : gounand@semt2.smts.cea.fr
  22. C***********************************************************************
  23. C APPELES :
  24. C APPELES (E/S) :
  25. C APPELES (BLAS) :
  26. C APPELES (CALCUL) :
  27. C APPELE PAR :
  28. C***********************************************************************
  29. C SYNTAXE GIBIANE :
  30. C ENTREES :
  31. C ENTREES/SORTIES :
  32. C SORTIES :
  33. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  34. C***********************************************************************
  35. C VERSION : v1, 27/06/2003, version initiale
  36. C HISTORIQUE : v1, 27/06/2003, création
  37. C HISTORIQUE :
  38. C HISTORIQUE :
  39. C***********************************************************************
  40. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  41. C en cas de modification de ce sous-programme afin de faciliter
  42. C la maintenance !
  43. C***********************************************************************
  44. -INC CCOPTIO
  45. -INC SMCOORD
  46. -INC SMRIGID
  47. POINTEUR MLIN.MRIGID
  48. POINTEUR DES.DESCR
  49. * POINTEUR IMAT.IMATRI
  50. POINTEUR XMAT.XMATRI
  51. -INC SMELEME
  52. POINTEUR MEL.MELEME
  53. * Includes persos
  54. CBEGININCLUDE SMMINC
  55. SEGMENT MINC
  56. INTEGER NPOS(NPT+1)
  57. INTEGER MPOS(NPT,NBI+1)
  58. ENDSEGMENT
  59. SEGMENT IMINC
  60. INTEGER LNUPO (NDDL)
  61. INTEGER LNUINC(NDDL)
  62. ENDSEGMENT
  63. CENDINCLUDE SMMINC
  64. POINTEUR MINCP.MINC
  65. POINTEUR MINCD.MINC
  66. CBEGININCLUDE SMPMORS
  67. SEGMENT PMORS
  68. INTEGER IA (NTT+1)
  69. INTEGER JA (NJA)
  70. ENDSEGMENT
  71. CENDINCLUDE SMPMORS
  72. POINTEUR PROFM.PMORS
  73. POINTEUR PMCOU.PMORS
  74. POINTEUR PMTMP.PMORS
  75. CBEGININCLUDE SMIZA
  76. SEGMENT IZA
  77. REAL*8 A(NBVA)
  78. ENDSEGMENT
  79. CENDINCLUDE SMIZA
  80. POINTEUR VALM.IZA
  81. * Segment LSTIND (liste séquentielle indexée)
  82. SEGMENT LSTIND
  83. INTEGER IDX(NBM+1)
  84. INTEGER IELRIG(NBTVAL)
  85. INTEGER ILIGR (NBTVAL)
  86. ENDSEGMENT
  87. POINTEUR DDDNUL.LSTIND
  88. *
  89. -INC SMLENTI
  90. POINTEUR KJSPGP.MLENTI
  91. POINTEUR KJSPGD.MLENTI
  92. POINTEUR KRSPGP.MLENTI
  93. POINTEUR KRSPGD.MLENTI
  94. POINTEUR KRINCP.MLENTI
  95. POINTEUR KRINCD.MLENTI
  96. -INC SMLMOTS
  97. POINTEUR LINCP.MLMOTS
  98. POINTEUR LINCD.MLMOTS
  99. *
  100. INTEGER IMPR,IRET
  101. *
  102. LOGICAL LEXIST
  103. *
  104. * Executable statements
  105. *
  106. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr14.eso'
  107. SEGACT MLIN
  108. NRIG=MLIN.IRIGEL(/2)
  109. * Construction des segments de repérage dans l'ensemble des points
  110. SEGACT KJSPGP
  111. NPOPRI=KJSPGP.LECT(/1)
  112. JG=XCOOR(/1)/(IDIM+1)
  113. SEGINI KRSPGP
  114. CALL RSETXI(KRSPGP.LECT,KJSPGP.LECT,NPOPRI)
  115. SEGDES KJSPGP
  116. SEGACT LINCP
  117. NINCP=LINCP.MOTS(/2)
  118. SEGACT MINCP
  119. *
  120. SEGACT KJSPGD
  121. NPODUA=KJSPGD.LECT(/1)
  122. JG=XCOOR(/1)/(IDIM+1)
  123. SEGINI KRSPGD
  124. CALL RSETXI(KRSPGD.LECT,KJSPGD.LECT,NPODUA)
  125. SEGDES KJSPGD
  126. SEGACT LINCD
  127. NINCD=LINCD.MOTS(/2)
  128. SEGACT MINCD
  129. * Initialisation du profil morse total (profil vide et non diagonal)
  130. NDDLPR=MINCP.NPOS(NPOPRI+1)-1
  131. NDDLDU=MINCD.NPOS(NPODUA+1)-1
  132. NTT=NDDLDU
  133. NJA=0
  134. SEGINI PROFM
  135. DO I=1,NDDLDU+1
  136. PROFM.IA(I)=1
  137. ENDDO
  138. SEGDES PROFM
  139. DO IRIG=1,NRIG
  140. MEL=MLIN.IRIGEL(1,IRIG)
  141. SEGACT MEL
  142. * a effacer NEL=MEL.NUM(/2)
  143. DES=MLIN.IRIGEL(3,IRIG)
  144. SEGACT DES
  145. NDDLOP=DES.NOELEP(/1)
  146. NDDLOD=DES.NOELED(/1)
  147. * Construction du segment de repérage dans les inconnues primales et duales
  148. JG=NDDLOP
  149. SEGINI KRINCP
  150. CALL CREPER(DES.LISINC(/1),NDDLOP,NINCP,
  151. $ DES.LISINC,LINCP.MOTS,
  152. $ KRINCP.LECT,
  153. $ IMPR,IRET)
  154. IF (IRET.NE.0) GOTO 9999
  155. JG=NDDLOD
  156. SEGINI KRINCD
  157. CALL CREPER(DES.LISDUA(/1),NDDLOD,NINCD,
  158. $ DES.LISDUA,LINCD.MOTS,
  159. $ KRINCD.LECT,
  160. $ IMPR,IRET)
  161. IF (IRET.NE.0) GOTO 9999
  162. * construction de la correspondance :
  163. * ieme ddl dual de la matrice assemblée <->
  164. * (numéro d'élément, numéro ddl dual local)
  165. * de la rigidité dans lesquels il apparait
  166. * In relr1a : SEGINI DDDNUL
  167. CALL RELR1A(MINCD,KRSPGD,KRINCD,
  168. $ MEL,DES,
  169. $ DDDNUL,
  170. $ IMPR,IRET)
  171. IF (IRET.NE.0) GOTO 9999
  172. * a effacer SEGPRT,DDDNUL
  173. * construction de la correspondance :
  174. * ieme ddl dual de la matrice assemblée <->
  175. * (numéros des ddl primaux avec lesquels il est
  176. * en relation). C'est le profil morse (non ordonné)
  177. * In relr1b : SEGINI PMCOU
  178. CALL RELR1B(DDDNUL,
  179. $ MINCP,KRSPGP,KRINCP,
  180. $ MEL,DES,
  181. $ PMCOU,
  182. $ IMPR,IRET)
  183. IF (IRET.NE.0) GOTO 9999
  184. * WRITE(IOIMP,*) ' ',IRIG
  185. * WRITE(IOIMP,*) 'IRIG=',IRIG
  186. * WRITE(IOIMP,*) ' ',IRIG
  187. * CALL ECMORS(PMCOU,0,3)
  188. * a effacer SEGPRT,PMCOU
  189. * In FUSPRM : SEGINI PMTMP
  190. CALL FUSPR2(PROFM,PMCOU,NDDLPR,
  191. $ PMTMP,
  192. $ IMPR,IRET)
  193. IF (IRET.NE.0) GOTO 9999
  194. * CALL ECMORS(PMTMP,0,3)
  195. SEGSUP PMCOU
  196. SEGSUP PROFM
  197. PROFM=PMTMP
  198. SEGSUP DDDNUL
  199. SEGSUP KRINCD
  200. SEGSUP KRINCP
  201. SEGDES DES
  202. SEGDES MEL
  203. ENDDO
  204. *
  205. * Ordonnancement du profil morse
  206. *
  207. CALL RELR1C(PROFM,NDDLPR,
  208. $ IMPR,IRET)
  209. IF (IRET.NE.0) GOTO 9999
  210. * SEGPRT,PROFM
  211. *
  212. * Remplissage des valeurs de la matrice Morse
  213. *
  214. SEGACT PROFM
  215. NNZ=PROFM.JA(/1)
  216. NBVA=NNZ
  217. SEGINI VALM
  218. DO IRIG=1,NRIG
  219. COEF=MLIN.COERIG(IRIG)
  220. MEL=MLIN.IRIGEL(1,IRIG)
  221. SEGACT MEL
  222. * a effacer NEL=MEL.NUM(/2)
  223. DES=MLIN.IRIGEL(3,IRIG)
  224. SEGACT DES
  225. NDDLOP=DES.NOELEP(/1)
  226. NDDLOD=DES.NOELED(/1)
  227. * Construction du segment de repérage dans les inconnues primales et duales
  228. JG=NDDLOP
  229. SEGINI KRINCP
  230. CALL CREPER(DES.LISINC(/1),NDDLOP,NINCP,
  231. $ DES.LISINC,LINCP.MOTS,
  232. $ KRINCP.LECT,
  233. $ IMPR,IRET)
  234. IF (IRET.NE.0) GOTO 9999
  235. JG=NDDLOD
  236. SEGINI KRINCD
  237. CALL CREPER(DES.LISDUA(/1),NDDLOD,NINCD,
  238. $ DES.LISDUA,LINCD.MOTS,
  239. $ KRINCD.LECT,
  240. $ IMPR,IRET)
  241. IF (IRET.NE.0) GOTO 9999
  242. * IMAT=MLIN.IRIGEL(4,IRIG)
  243. * SEGACT IMAT
  244. XMAT=MLIN.IRIGEL(4,IRIG)
  245. SEGACT XMAT
  246. * Compléter les valeurs de la matrice morse avec celles
  247. * de XMAT
  248. CALL RELR1D(MINCP,KRSPGP,KRINCP,
  249. $ MINCD,KRSPGD,KRINCD,
  250. $ COEF,MEL,DES,XMAT,
  251. $ PROFM,
  252. $ VALM,
  253. $ IMPR,IRET)
  254. IF (IRET.NE.0) GOTO 9999
  255. * WRITE(IOIMP,*) 'IRIG=',IRIG
  256. * CALL ECMORS(PROFM,VALM,3)
  257. * stop 16
  258.  
  259. * SEGDES IMAT
  260. SEGDES XMAT
  261. SEGSUP KRINCD
  262. SEGSUP KRINCP
  263. SEGDES DES
  264. SEGDES MEL
  265. ENDDO
  266. SEGDES VALM
  267. SEGDES PROFM
  268. SEGDES MINCD
  269. SEGDES LINCD
  270. SEGSUP KRSPGD
  271. SEGDES MINCP
  272. SEGDES LINCP
  273. SEGSUP KRSPGP
  274. SEGDES MLIN
  275. *
  276. * Normal termination
  277. *
  278. IRET=0
  279. RETURN
  280. *
  281. * Format handling
  282. *
  283. *
  284. * Error handling
  285. *
  286. 9999 CONTINUE
  287. IRET=1
  288. WRITE(IOIMP,*) 'An error was detected in subroutine relr14'
  289. RETURN
  290. *
  291. * End of subroutine RELR14
  292. *
  293. END
  294.  
  295.  
  296.  
  297.  

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