Télécharger kres9.eso

Retour à la liste

Numérotation des lignes :

  1. C KRES9 SOURCE PV 16/11/17 22:00:26 9180
  2. SUBROUTINE KRES9(MRIGID,INORMU)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : KRES9
  7. C DESCRIPTION : - Assemblage comme par RESOU
  8. C
  9. C
  10. C LANGAGE : ESOPE
  11. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  12. C mél : gounand@semt2.smts.cea.fr
  13. C***********************************************************************
  14. C VERSION : v1, 04/08/2011, version initiale
  15. C HISTORIQUE : v1, 04/08/2011, création
  16. C HISTORIQUE : JCARDO 16/07/2013, ajout de INORMU (cf LDMT2)
  17. C HISTORIQUE :
  18. C***********************************************************************
  19. REAL*8 XKT,PREC
  20. -INC SMRIGID
  21. -INC SMMATRI
  22. -INC CCOPTIO
  23. C ... Ces variables ont pour but, de diriger le comportement de LDMT2 ...
  24. C TRSUP - TRiangle SUPérieur
  25. C MENAGE - évident
  26. C LDIAG - initialisation et remplissage de MDIAG et MDNOR demandés
  27. C
  28. LOGICAL TRSUP,MENAGE,LDIAG
  29. *
  30. * Executable statements
  31. *
  32. * WRITE(IOIMP,*) 'Entrée dans kres8.eso'
  33. *
  34. SEGACT MRIGID
  35. ICHOLX=ICHOLE
  36. SEGDES MRIGID
  37. IF(ICHOLX.NE.0) RETURN
  38. * Ici l'assemblage proprement dit recopié de LDMT1
  39. IF(IIMPI.EQ.1)THEN
  40. CALL GIBTEM(XKT)
  41. INTERR(1)=INT(XKT)
  42. CALL ERREUR(-259)
  43. ENDIF
  44. IF(IIMPI.EQ.1)WRITE(IOIMP,10)
  45. 10 FORMAT(' L''IMPRESSION PRECEDENTE EST AVANT ASNS1 ')
  46.  
  47. C ... MMATRI est initialisé dans ASSEM1 et renvoyé en tant que résultat
  48. C dans la variable MMATRX, il est désactivé à la sortie ...
  49. CALL ASNS1(MRIGID,MMATRX,INUINX,ITOPOX,IMINIX,IPOX,INCTRX,INCTRZ,
  50. & IITOPX,ITOPOD,IITOPD,IPODD)
  51. IF(IERR.NE.0) RETURN
  52.  
  53. IF(IIMPI.EQ.1) THEN
  54. CALL GIBTEM(XKT)
  55. INTERR(1)=INT(XKT)
  56. CALL ERREUR(-259)
  57. ENDIF
  58. IF(IIMPI.EQ.1)WRITE(IOIMP,11)
  59. 11 FORMAT(' L''IMPRESSION PRECEDENTE EST AVANT LDMT2')
  60. C ... On initialise IJMAX ici et non dans LDMT2, car celui-ci est
  61. C appelé deux fois ...
  62. MMATRI=MMATRX
  63. SEGACT,MMATRI*MOD
  64. IJMAX=0
  65. SEGDES,MMATRI
  66. C
  67. TRSUP =.FALSE.
  68. MENAGE=.FALSE.
  69. LDIAG =.TRUE.
  70. njtot=0
  71. * write(6,*) ' premier appel'
  72. CALL LDMT2(MRIGID,ITOPOX,INUINX,IMINIX,MMATRX,IPOX,INCTRX,INCTRZ,
  73. & IITOPX,TRSUP,MENAGE,LDIAG,IITOPD,ITOPOD,IPODD,njtot,INORMU)
  74. IF(IERR.NE.0) RETURN
  75. TRSUP =.TRUE.
  76. MENAGE=.TRUE.
  77. LDIAG =.FALSE.
  78. * write(6,*) ' deucxieme appel'
  79. CALL LDMT2(MRIGID,ITOPOX,INUINX,IMINIX,MMATRX,IPOX,INCTRX,INCTRZ,
  80. & IITOPX,TRSUP,MENAGE,LDIAG,IITOPD,ITOPOD,IPODD,njtot,INORMU)
  81. IF(IERR.NE.0) RETURN
  82.  
  83. IF(IIMPI.EQ.1)THEN
  84. CALL GIBTEM(XKT)
  85. INTERR(1)=INT(XKT)
  86. CALL ERREUR(-259)
  87. ENDIF
  88. IF(IIMPI.EQ.1) WRITE(IOIMP,12)
  89. 12 FORMAT(' L''IMPRESSION PRECEDENTE EST AVANT LA FIN DE KRES9')
  90. IF(IERR.NE.0) RETURN
  91. *
  92. * Analyse de la structure
  93. *
  94. C MMATRI=MMATRX
  95. C SEGACT MMATRI
  96. C WRITE(IOIMP,*) 'IJMAX=',IJMAX
  97. C WRITE(IOIMP,*) 'IDIAG=',IDIAG
  98. C WRITE(IOIMP,*) 'IGEOMA=',IGEOMA
  99. C WRITE(IOIMP,*) 'IINCPO=',IINCPO
  100. C WRITE(IOIMP,*) 'IIDUA=',IIDUA
  101. C WRITE(IOIMP,*) 'IIMIK=',IIMIK
  102. C WRITE(IOIMP,*) 'INEG=',INEG
  103. C WRITE(IOIMP,*) 'IDNORM=',IDNORM
  104. C WRITE(IOIMP,*) 'IILIGN=',IILIGN
  105. C WRITE(IOIMP,*) 'IILIGS=',IILIGS
  106. C WRITE(IOIMP,*) 'NENS=',NENS
  107. C WRITE(IOIMP,*) 'IHARK=',IHARK
  108. C WRITE(IOIMP,*) 'IASLIG=',IASLIG
  109. C WRITE(IOIMP,*) 'IASDIA=',IASDIA
  110. C WRITE(IOIMP,*) 'IDUAPO=',IDUAPO
  111. C WRITE(IOIMP,*) 'IHARDU=',IHARDU
  112. C WRITE(IOIMP,*) 'IDNORD=',IDNORD
  113. C WRITE(IOIMP,*) 'PRCHLV=',PRCHLV
  114. C* SEGPRT,MMATRI
  115. C IF (IGEOMA.NE.0) THEN
  116. C MELEME=IGEOMA
  117. C WRITE(IOIMP,*) 'IGEOMA'
  118. C CALL ECMAIL(MELEME,0)
  119. C ENDIF
  120. C IF (IIMIK.NE.0) THEN
  121. C MIMIK=IIMIK
  122. C SEGACT MIMIK
  123. C N=IMIK(/2)
  124. C WRITE(IOIMP,*) 'IIMIK N=',N
  125. C WRITE(IOIMP,2019) (IMIK(I),I=1,N)
  126. C ENDIF
  127. C IF (IIDUA.NE.0) THEN
  128. C MIDUA=IIDUA
  129. C SEGACT MIDUA
  130. C N=IDUA(/2)
  131. C WRITE(IOIMP,*) 'IIDUA N=',N
  132. C WRITE(IOIMP,2019) (IDUA(I),I=1,N)
  133. C ENDIF
  134. C IF (IINCPO.NE.0) THEN
  135. C MINCPO=IINCPO
  136. C SEGACT MINCPO
  137. C MAXI=INCPO(/1)
  138. C NNOE=INCPO(/2)
  139. C WRITE(IOIMP,*) 'IINCPO MAXI=',MAXI,' NNOE=',NNOE
  140. C WRITE(IOIMP,*) 'Tableau de correspondance Inconnue-Point'
  141. C $ ,'-> DDL'
  142. C DO 146 L=1,MAXI,10
  143. C WRITE(IOIMP,'(8X,A)') 'Inconnue'
  144. C LH = MIN(L+9,MAXI)
  145. C WRITE(IOIMP,*) 'LH=',LH
  146. C WRITE (IOIMP,147) 'Point',(M,M=L,LH)
  147. C 147 FORMAT (A8,10I8)
  148. C DO 148 J=1,NNOE
  149. C WRITE(IOIMP,149) J,(INCPO(K,J),K=L,LH)
  150. C 149 FORMAT (11I8)
  151. C 148 CONTINUE
  152. C 146 CONTINUE
  153. C ENDIF
  154. C IF (IDUAPO.NE.0) THEN
  155. C MINCPO=IDUAPO
  156. C SEGACT MINCPO
  157. C MAXI=INCPO(/1)
  158. C NNOE=INCPO(/2)
  159. C WRITE(IOIMP,*) 'IDUAPO MAXI=',MAXI,' NNOE=',NNOE
  160. C WRITE(IOIMP,*) 'Tableau de correspondance Inconnue-Point'
  161. C $ ,'-> DDL'
  162. C DO 246 L=1,MAXI,10
  163. C WRITE(IOIMP,'(8X,A)') 'Inconnue'
  164. C LH = MIN(L+9,MAXI)
  165. C WRITE (IOIMP,247) 'Point',(M,M=L,LH)
  166. C 247 FORMAT (A8,10I8)
  167. C DO 248 J=1,NNOE
  168. C WRITE(IOIMP,249) J,(INCPO(K,J),K=L,LH)
  169. C 249 FORMAT (11I8)
  170. C 248 CONTINUE
  171. C 246 CONTINUE
  172. C ENDIF
  173. C IF (IDIAG.NE.0) THEN
  174. C MDIAG=IDIAG
  175. C SEGACT MDIAG
  176. C WRITE(IOIMP,*) 'IDIAG INC=',DIAG(/1)
  177. C WRITE(IOIMP,2022) (DIAG(II),II=1,DIAG(/1))
  178. C ENDIF
  179. C IF (IDNORM.NE.0) THEN
  180. C MDNOR=IDNORM
  181. C SEGACT MDNOR
  182. C WRITE(IOIMP,*) 'IDNORM INC=',DNOR(/1)
  183. C WRITE(IOIMP,2022) (DNOR(II),II=1,DNOR(/1))
  184. C ENDIF
  185. C IF (IDNORD.NE.0) THEN
  186. C MDNOR=IDNORD
  187. C SEGACT MDNOR
  188. C WRITE(IOIMP,*) 'IDNORD INC=',DNOR(/1)
  189. C WRITE(IOIMP,2022) (DNOR(II),II=1,DNOR(/1))
  190. C ENDIF
  191. C IF (IILIGN.NE.0) THEN
  192. C MILIGN=IILIGN
  193. C SEGACT MILIGN
  194. C WRITE(IOIMP,*) 'IILIGN INC=',IPNO(/1),' NNOE=',ILIGN(/1)
  195. C WRITE(IOIMP,*) ' IPNO'
  196. C WRITE(IOIMP,2020) (IPNO(II),II=1,IPNO(/1))
  197. C WRITE(IOIMP,*) ' ITTR'
  198. C WRITE(IOIMP,2020) (ITTR(II),II=1,ITTR(/1))
  199. C DO INOE=1,ILIGN(/1)
  200. C WRITE(IOIMP,*) ' Point ', INOE
  201. C LLIGN=ILIGN(INOE)
  202. C SEGACT LLIGN
  203. C WRITE(IOIMP,*) ' LLIGN NA=',IMMMM(/1),' LLVVA=',XXVA(/1)
  204. C WRITE(IOIMP,*) ' NJMAX=',NJMAX
  205. C WRITE(IOIMP,*) ' IMMMM'
  206. C WRITE(IOIMP,2020) (IMMMM(II),II=1,IMMMM(/1))
  207. C WRITE(IOIMP,*) ' LDEB'
  208. C WRITE(IOIMP,2020) (LDEB(II),II=1,LDEB(/1))
  209. C WRITE(IOIMP,*) ' IPPO'
  210. C WRITE(IOIMP,2020) (IPPO(II),II=1,IPPO(/1))
  211. C WRITE(IOIMP,*) ' LINC'
  212. C WRITE(IOIMP,2020) (LINC(II),II=1,LINC(/1))
  213. C WRITE(IOIMP,*) ' XXVA'
  214. C WRITE(IOIMP,2022) (XXVA(II),II=1,XXVA(/1))
  215. C ENDDO
  216. C ENDIF
  217. C IF (IILIGS.NE.0) THEN
  218. C MILIGN=IILIGS
  219. C SEGACT MILIGN
  220. C WRITE(IOIMP,*) 'IILIGS INC=',IPNO(/1),' NNOE=',ILIGN(/1)
  221. C WRITE(IOIMP,*) ' IPNO'
  222. C WRITE(IOIMP,2020) (IPNO(II),II=1,IPNO(/1))
  223. C WRITE(IOIMP,*) ' ITTR'
  224. C WRITE(IOIMP,2020) (ITTR(II),II=1,ITTR(/1))
  225. C DO INOE=1,ILIGN(/1)
  226. C WRITE(IOIMP,*) ' Point ', INOE
  227. C LLIGN=ILIGN(INOE)
  228. C SEGACT LLIGN
  229. C WRITE(IOIMP,*) ' LLIGN NA=',IMMMM(/1),' LLVVA=',XXVA(/1)
  230. C WRITE(IOIMP,*) ' NJMAX=',NJMAX
  231. C WRITE(IOIMP,*) ' IMMMM'
  232. C WRITE(IOIMP,2020) (IMMMM(II),II=1,IMMMM(/1))
  233. C WRITE(IOIMP,*) ' LDEB'
  234. C WRITE(IOIMP,2020) (LDEB(II),II=1,LDEB(/1))
  235. C WRITE(IOIMP,*) ' IPPO'
  236. C WRITE(IOIMP,2020) (IPPO(II),II=1,IPPO(/1))
  237. C WRITE(IOIMP,*) ' LINC'
  238. C WRITE(IOIMP,2020) (LINC(II),II=1,LINC(/1))
  239. C WRITE(IOIMP,*) ' XXVA'
  240. C WRITE(IOIMP,2022) (XXVA(II),II=1,XXVA(/1))
  241. C ENDDO
  242. C ENDIF
  243. C 2019 FORMAT (20(2X,A4) )
  244. C 2020 FORMAT (20(2X,I4) )
  245. C 2021 FORMAT (20(2X,L4) )
  246. C 2022 FORMAT(10(1X,1PG12.5))
  247. SEGACT MRIGID*MOD
  248. ICHOLE=MMATRX
  249. SEGDES MRIGID
  250. RETURN
  251. *
  252. * End of subroutine KRES9
  253. *
  254. END
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  

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