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

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