Télécharger ajmtk.eso

Retour à la liste

Numérotation des lignes :

  1. C AJMTK SOURCE PV 16/11/17 21:58:06 9180
  2. SUBROUTINE AJMTK(GMS,MK,IMPR,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM : AJMTK
  7. C DESCRIPTION : Ajoute à un objet matrice de type MATRIK, un objet
  8. C matrice simplifiée de type GMATSI (voir définition du
  9. C segment ci-dessous).
  10. C
  11. C
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES : -
  18. C APPELES (UTIL) : RSETI : copie d'un tableau d'entiers.
  19. C APPELE PAR : YLAP1{B,C,D,E}
  20. C***********************************************************************
  21. C ENTREES : MS (type MATSIM) : objet matrice à ajouter.
  22. C ENTREES/SORTIES : MK (type MATRIK) : en sortie, est égal à :
  23. C MK (en entrée) + MS
  24. C SORTIES : -
  25. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26. C***********************************************************************
  27. C VERSION : v1, 03/08/2001, version initiale
  28. C HISTORIQUE : v1, 03/08/2001, création
  29. C HISTORIQUE :
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33. C en cas de modification de ce sous-programme afin de faciliter
  34. C la maintenance !
  35. C***********************************************************************
  36. -INC CCOPTIO
  37. INTEGER NRIGE,NMATRI,NKID,NKMT
  38. INTEGER NBSOUS,NBME
  39. INTEGER NBEL,NP,MP
  40. POINTEUR MK.MATRIK
  41. POINTEUR IK.IMATRI
  42. POINTEUR JK.IZAFM
  43. -INC SMELEME
  44. INTEGER NBNN,NBELEM,NBREF
  45. POINTEUR MAIPRI.MELEME
  46. POINTEUR MAIDUA.MELEME
  47. *
  48. * Objet matrice élémentaire simplifié
  49. *
  50. SEGMENT GMATSI
  51. INTEGER POIPR1(NPP1,NEL1)
  52. INTEGER POIDU1(1,NEL1)
  53. INTEGER POIPR2(NPP2,NEL2)
  54. INTEGER POIDU2(2,NEL2)
  55. POINTEUR LMATSI(0).MATSIM
  56. ENDSEGMENT
  57. POINTEUR GMS.GMATSI
  58. SEGMENT MATSIM
  59. CHARACTER*8 NOMPRI,NOMDUA
  60. REAL*8 VALMA1(1,NPP1,NEL1)
  61. REAL*8 VALMA2(2,NPP2,NEL2)
  62. ENDSEGMENT
  63. POINTEUR MS.MATSIM
  64. *
  65. INTEGER IMPR,IRET
  66. *
  67. INTEGER IPOPR1,IPOPR2,IMAT,IELEM1,IELEM2
  68. INTEGER NPOPR1,NPOPR2,NMAT,NELEM1,NELEM2
  69. *
  70. * Executable statements
  71. *
  72. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans ajmtk.eso'
  73. SEGACT GMS
  74. NPOPR1=GMS.POIPR1(/1)
  75. NPOPR2=GMS.POIPR2(/1)
  76. NELEM1=GMS.POIPR1(/2)
  77. NELEM2=GMS.POIPR2(/2)
  78. IF (NELEM1.GT.0) THEN
  79. *
  80. * Création du premier MATRIK
  81. *
  82. * Création de MAIPRI
  83. NBNN=NPOPR1
  84. NBELEM=NELEM1
  85. NBSOUS=0
  86. NBREF=0
  87. SEGINI,MAIPRI
  88. C ITYPEL=32 -> 'POLY'
  89. MAIPRI.ITYPEL=32
  90. CALL RSETI(MAIPRI.NUM,GMS.POIPR1,NPOPR1*NELEM1)
  91. SEGDES MAIPRI
  92. * Création de MAIDUA
  93. NBNN=1
  94. NBELEM=NELEM1
  95. NBSOUS=0
  96. NBREF=0
  97. SEGINI,MAIDUA
  98. C ITYPEL=32 -> 'POLY'
  99. MAIDUA.ITYPEL=32
  100. CALL RSETI(MAIDUA.NUM,GMS.POIDU1,NELEM1)
  101. SEGDES MAIDUA
  102. * Création de IK (noms d'inconnues+pointeurs sur valeurs des matrices
  103. * élémentaires)
  104. NMAT=GMS.LMATSI(/1)
  105. NBME=NMAT
  106. NBSOUS=1
  107. SEGINI IK
  108. DO 1 IMAT=1,NMAT
  109. MS=GMS.LMATSI(IMAT)
  110. SEGACT MS
  111. * Création de JK (matrice élémentaire)
  112. NBEL=NELEM1
  113. NP=NPOPR1
  114. MP=1
  115. SEGINI JK
  116. DO 12 IELEM1=1,NELEM1
  117. DO 122 IPOPR1=1,NPOPR1
  118. JK.AM(IELEM1,IPOPR1,1)=MS.VALMA1(1,IPOPR1,IELEM1)
  119. 122 CONTINUE
  120. 12 CONTINUE
  121. SEGDES JK
  122. IK.LISPRI(IMAT)=MS.NOMPRI
  123. IK.LISDUA(IMAT)=MS.NOMDUA
  124. IK.LIZAFM(1,IMAT)=JK
  125. SEGDES MS
  126. 1 CONTINUE
  127. SEGDES IK
  128. * Mise à jour de MK (pointeurs sur les matrices élémentaires)
  129. SEGACT MK*MOD
  130. NMATRI=MK.IRIGEL(/2)+1
  131. NRIGE=MK.IRIGEL(/1)
  132. NKID=MK.KIDMAT(/1)
  133. NKMT=MK.KKMMT(/1)
  134. SEGADJ,MK
  135. MK.IRIGEL(1,NMATRI)=MAIPRI
  136. MK.IRIGEL(2,NMATRI)=MAIDUA
  137. MK.IRIGEL(4,NMATRI)=IK
  138. * Matrice rectangulaire
  139. MK.IRIGEL(7,NMATRI)=3
  140. SEGDES MK
  141. ENDIF
  142. IF (NELEM2.GT.0) THEN
  143. *
  144. * Création du deuxième MATRIK
  145. *
  146. * Création de MAIPRI
  147. NBNN=NPOPR2
  148. NBELEM=NELEM2
  149. NBSOUS=0
  150. NBREF=0
  151. SEGINI,MAIPRI
  152. C ITYPEL=32 -> 'POLY'
  153. MAIPRI.ITYPEL=32
  154. CALL RSETI(MAIPRI.NUM,GMS.POIPR2,NPOPR2*NELEM2)
  155. SEGDES MAIPRI
  156. * Création de MAIDUA
  157. NBNN=2
  158. NBELEM=NELEM2
  159. NBSOUS=0
  160. NBREF=0
  161. SEGINI,MAIDUA
  162. C ITYPEL=32 -> 'POLY'
  163. MAIDUA.ITYPEL=32
  164. CALL RSETI(MAIDUA.NUM,GMS.POIDU2,2*NELEM2)
  165. SEGDES MAIDUA
  166. * Création de IK (noms d'inconnues+pointeurs sur valeurs des matrices
  167. * élémentaires)
  168. NMAT=GMS.LMATSI(/1)
  169. NBME=NMAT
  170. NBSOUS=1
  171. SEGINI IK
  172. DO 3 IMAT=1,NMAT
  173. MS=GMS.LMATSI(IMAT)
  174. SEGACT MS
  175. * Création de JK (matrice élémentaire)
  176. NBEL=NELEM2
  177. NP=NPOPR2
  178. MP=2
  179. SEGINI JK
  180. DO 32 IELEM2=1,NELEM2
  181. DO 322 IPOPR2=1,NPOPR2
  182. JK.AM(IELEM2,IPOPR2,1)=MS.VALMA2(1,IPOPR2,IELEM2)
  183. JK.AM(IELEM2,IPOPR2,2)=MS.VALMA2(2,IPOPR2,IELEM2)
  184. 322 CONTINUE
  185. 32 CONTINUE
  186. SEGDES JK
  187. IK.LISPRI(IMAT)=MS.NOMPRI
  188. IK.LISDUA(IMAT)=MS.NOMDUA
  189. IK.LIZAFM(1,IMAT)=JK
  190. SEGDES MS
  191. 3 CONTINUE
  192. SEGDES IK
  193. SEGDES GMS
  194. * Mise à jour de MK (pointeurs sur les matrices élémentaires)
  195. SEGACT MK*MOD
  196. NMATRI=MK.IRIGEL(/2)+1
  197. NRIGE=MK.IRIGEL(/1)
  198. NKID=MK.KIDMAT(/1)
  199. NKMT=MK.KKMMT(/1)
  200. SEGADJ,MK
  201. MK.IRIGEL(1,NMATRI)=MAIPRI
  202. MK.IRIGEL(2,NMATRI)=MAIDUA
  203. MK.IRIGEL(4,NMATRI)=IK
  204. * Matrice rectangulaire
  205. MK.IRIGEL(7,NMATRI)=3
  206. SEGDES MK
  207. ENDIF
  208. *
  209. * Normal termination
  210. *
  211. IRET=0
  212. RETURN
  213. *
  214. * Format handling
  215. *
  216. *
  217. * Error handling
  218. *
  219. 9999 CONTINUE
  220. IRET=1
  221. WRITE(IOIMP,*) 'An error was detected in subroutine ajmtk'
  222. RETURN
  223. *
  224. * End of subroutine AJMTK
  225. *
  226. END
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  

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