Télécharger incor2.eso

Retour à la liste

Numérotation des lignes :

  1. C INCOR2 SOURCE PV 16/11/17 21:59:40 9180
  2. SUBROUTINE INCOR2(MATELE,IMULAG,LITOT,LITYP,LINIV,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INCOR2
  7. C DESCRIPTION :
  8. C
  9. C Construction de l'ensemble des noms d'inconnues possibles LITOT
  10. C et attribution d'un ordre.
  11. C On voudra qu'un ddl d'ordre i soit après au moins un ddl d'ordre
  12. C i-1 avec lequel il a une relation
  13. C LITOT : liste des noms d'inconnues
  14. C LIORD : ordre pour chaque inconnue
  15. C LITYP : type d'inconnue 1 : trusted
  16. C 2 : untrusted
  17. C 3 : premier multiplicateur
  18. C 4 : deuxième multiplicateur
  19. C LINIV : niveau de multiplicateur 1 : n'est pas un multiplicateur
  20. C 2 : est un multiplicateur qui
  21. C porte au moins sur un 1
  22. C 3 : est un multiplicateur qui
  23. C porte au moins sur un 2
  24. C ...
  25. C
  26. C
  27. C LANGAGE : ESOPE
  28. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  29. C mél : gounand@semt2.smts.cea.fr
  30. C***********************************************************************
  31. C SYNTAXE GIBIANE :
  32. C ENTREES :
  33. C ENTREES/SORTIES :
  34. C SORTIES :
  35. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  36. C***********************************************************************
  37. C VERSION : v1, 24/03/2004, version initiale
  38. C HISTORIQUE : v1, 24/03/2004, création
  39. C HISTORIQUE :
  40. C HISTORIQUE :
  41. C***********************************************************************
  42. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  43. C en cas de modification de ce sous-programme afin de faciliter
  44. C la maintenance !
  45. C***********************************************************************
  46. -INC CCOPTIO
  47. POINTEUR MATELE.MATRIK
  48. POINTEUR IMATEL.IMATRI
  49. -INC SMLMOTS
  50. POINTEUR GPINCS.MLMOTS
  51. POINTEUR LITOT.MLMOTS
  52. POINTEUR LITOT2.MLMOTS
  53. -INC SMLENTI
  54. POINTEUR LINIV.MLENTI
  55. POINTEUR LINIV2.MLENTI
  56. POINTEUR LITYP.MLENTI
  57. POINTEUR LITYP2.MLENTI
  58. POINTEUR LORD.MLENTI
  59. POINTEUR LIORD.MLENTI
  60. C! POINTEUR LIORD2.MLENTI
  61. POINTEUR LIPERM.MLENTI
  62. LOGICAL LOK
  63. *
  64. INTEGER LNMOTS
  65. PARAMETER (LNMOTS=8)
  66. CHARACTER*8 MONMOT,MONMOD,MONMOP
  67. LOGICAL LRELA
  68. LOGICAL LTYNU2,LTYP1
  69. *
  70. INTEGER IMPR,IRET
  71. *
  72. * Executable statements
  73. *
  74. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans incor2.eso'
  75. LTYNU2=(IMULAG.EQ.4.OR.IMULAG.EQ.5)
  76. *
  77. SEGACT MATELE
  78. NMATE = MATELE.IRIGEL(/2)
  79. *
  80. * Construction de la liste des inconnues
  81. *
  82. NBMTOT=0
  83. DO 3 IMATE=1,NMATE
  84. IMATEL=MATELE.IRIGEL(4,IMATE)
  85. SEGACT IMATEL
  86. NBMTOT=NBMTOT+IMATEL.LISPRI(/2)
  87. SEGDES IMATEL
  88. 3 CONTINUE
  89. JGN=LNMOTS
  90. JGM=2*NBMTOT
  91. SEGINI GPINCS
  92. SEGINI LITOT
  93. NBM2=0
  94. DO 4 IMATE=1,NMATE
  95. IMATEL=MATELE.IRIGEL(4,IMATE)
  96. SEGACT IMATEL
  97. DO 42 IBME=1,IMATEL.LISPRI(/2)
  98. NBM2=NBM2+1
  99. GPINCS.MOTS(NBM2)=IMATEL.LISPRI(IBME)
  100. 42 CONTINUE
  101. DO 43 IBME=1,IMATEL.LISDUA(/2)
  102. NBM2=NBM2+1
  103. GPINCS.MOTS(NBM2)=IMATEL.LISDUA(IBME)
  104. 43 CONTINUE
  105. SEGDES IMATEL
  106. 4 CONTINUE
  107. CALL CUNIQ(GPINCS.MOTS,LNMOTS,NBM2,
  108. $ LITOT.MOTS,NBUNIQ,
  109. $ IMPR,IRET)
  110. IF (IRET.NE.0) GOTO 9999
  111. JGN=LNMOTS
  112. JGM=NBUNIQ
  113. SEGADJ LITOT
  114. SEGSUP GPINCS
  115. *
  116. * SEGPRT,LITOT
  117. *
  118. * Construction de la liste des types
  119. JG=LITOT.MOTS(/2)
  120. SEGINI LITYP
  121. * Par défaut, toutes les inconnues ont le type untrusted (2)
  122. DO IORD=1,LITYP.LECT(/1)
  123. LITYP.LECT(IORD)=2
  124. ENDDO
  125. * On parcourt la liste des noms pour donner un type trusted (1)
  126. * ou multiplicateur de Lagrange premier (3) ou deuxième (4).
  127. DO ITOT=1,LITOT.MOTS(/2)
  128. * IF (LITOT.MOTS(ITOT)(1:1).EQ.'$') THEN
  129. * LITYP.LECT(ITOT)=1
  130. * ELSEIF (LITOT.MOTS(ITOT)(1:2).EQ.'LX') THEN
  131. IF (LITOT.MOTS(ITOT)(1:2).EQ.'LX') THEN
  132. LITYP.LECT(ITOT)=3
  133. ENDIF
  134. ENDDO
  135. DO IMATE=1,NMATE
  136. IMATYP=MATELE.IRIGEL(7,IMATE)
  137. IF (IMATYP.EQ.4.OR.IMATYP.EQ.-3.OR.IMATYP.EQ.-4) THEN
  138. IMATEL=MATELE.IRIGEL(4,IMATE)
  139. SEGACT IMATEL
  140. DO IBME=1,IMATEL.LISDUA(/2)
  141. MONMOT=IMATEL.LISDUA(IBME)
  142. CALL FIMOTS(MONMOT,LITOT,IORD,IMPR,IRET)
  143. IF (IRET.NE.0) GOTO 9999
  144. IF (IMATYP.EQ.-4) THEN
  145. LITYP.LECT(IORD)=4
  146. ELSE
  147. LITYP.LECT(IORD)=3
  148. ENDIF
  149. ENDDO
  150. SEGDES IMATEL
  151. ENDIF
  152. ENDDO
  153. * SEGPRT,LITYP
  154. *
  155. * On construit LINIV
  156. *
  157. JG=LITOT.MOTS(/2)
  158. SEGINI LINIV
  159. * On fait d'abord les types trusted et untrusted
  160. DO ITYP=1,2
  161. DO IINC=1,LITOT.MOTS(/2)
  162. IF (LITYP.LECT(IINC).EQ.ITYP) THEN
  163. LINIV.LECT(IINC)=1
  164. ENDIF
  165. ENDDO
  166. ENDDO
  167. * Les inconnues qui ont le type muliplicateur de Lagrange
  168. * mais qui n'ont de relations qu'avec elles-memes
  169. * se font attribuer un niveau 1.
  170. DO ITYP=3,4
  171. DO IINC=1,LITOT.MOTS(/2)
  172. IF (LITYP.LECT(IINC).EQ.ITYP) THEN
  173. MONMOD=LITOT.MOTS(IINC)
  174. LRELA=.TRUE.
  175. DO IMATE=1,NMATE
  176. IMATEL=MATELE.IRIGEL(4,IMATE)
  177. SEGACT IMATEL
  178. DO IBME=1,IMATEL.LISDUA(/2)
  179. IF (IMATEL.LISDUA(IBME).EQ.MONMOD) THEN
  180. MONMOP=IMATEL.LISPRI(IBME)
  181. *rajout 10/04/2009
  182. CALL FIMOTS(MONMOP,LITOT,IORP,IMPR,IRET)
  183. IF (IRET.NE.0) GOTO 9999
  184. ITYPP=LITYP.LECT(IORP)
  185. IF (MONMOP.NE.MONMOD.AND.(ITYPP.NE.ITYP)) THEN
  186. * IF (.NOT.(MONMOP.EQ.MONMOD)) THEN
  187. LRELA=.FALSE.
  188. ENDIF
  189. ENDIF
  190. ENDDO
  191. SEGDES IMATEL
  192. ENDDO
  193. IF (LRELA) THEN
  194. * LIORD.LECT(IINC)=IORD
  195. * IORD=IORD+1
  196. LINIV.LECT(IINC)=1
  197. ENDIF
  198. ENDIF
  199. ENDDO
  200. ENDDO
  201. SEGDES LITYP
  202. *
  203. * WRITE(IOIMP,*) ' Coucou les gars'
  204. *
  205. * SEGPRT,LITOT
  206. * SEGPRT,LINIV
  207. * SEGPRT,LIORD
  208. * SEGPRT,LIORD
  209. * On s'occupe des inconnues n'ayant pas de niveau.
  210. NLAG=0
  211. DO IINC=1,LITOT.MOTS(/2)
  212. INIV=LINIV.LECT(IINC)
  213. IF (INIV.EQ.0) THEN
  214. NLAG=NLAG+1
  215. ENDIF
  216. ENDDO
  217. *
  218. * WRITE(IOIMP,*) 'NLAG=',NLAG
  219. *
  220. DO IBCL=1,LITOT.MOTS(/2)
  221. * 9 CONTINUE
  222. IF (NLAG.GT.0) THEN
  223. DO IINC=1,LITOT.MOTS(/2)
  224. INIV=LINIV.LECT(IINC)
  225. IF (INIV.EQ.0) THEN
  226. MONMOD=LITOT.MOTS(IINC)
  227. * WRITE(IOIMP,*) 'IINC=',IINC
  228. * WRITE(IOIMP,*) 'MONMOD=',MONMOD
  229. LOK=.FALSE.
  230. DO IMATE=1,NMATE
  231. IMATEL=MATELE.IRIGEL(4,IMATE)
  232. SEGACT IMATEL
  233. DO IBME=1,IMATEL.LISDUA(/2)
  234. IF (IMATEL.LISDUA(IBME).EQ.MONMOD) THEN
  235. MONMOP=IMATEL.LISPRI(IBME)
  236. IF (MONMOP.NE.MONMOD) THEN
  237. CALL FIMOTS(MONMOP,LITOT,JINC,IMPR,IRET)
  238. IF (IRET.NE.0) GOTO 9999
  239. KNIV=LINIV.LECT(JINC)
  240. * WRITE(IOIMP,*) 'MONMOP=',MONMOP
  241. * WRITE(IOIMP,*) 'KNIV=',KNIV
  242. IF (KNIV.NE.0) THEN
  243. * LOK=.FALSE.
  244. * ELSE
  245. LOK=.TRUE.
  246. INIV=MAX(INIV,KNIV+1)
  247. ENDIF
  248. ENDIF
  249. ENDIF
  250. ENDDO
  251. SEGDES IMATEL
  252. ENDDO
  253. * WRITE(IOIMP,*) 'LOK=',LOK
  254. IF (LOK) THEN
  255. NLAG=NLAG-1
  256. LINIV.LECT(IINC)=INIV
  257. ENDIF
  258. ENDIF
  259. ENDDO
  260. * GOTO 9
  261. ENDIF
  262. ENDDO
  263. SEGDES MATELE
  264. SEGDES LINIV
  265. *
  266. * Normal termination
  267. *
  268. IRET=0
  269. RETURN
  270. *
  271. * Format handling
  272. *
  273. *
  274. * Error handling
  275. *
  276. 9999 CONTINUE
  277. IRET=1
  278. WRITE(IOIMP,*) 'An error was detected in subroutine incor2'
  279. RETURN
  280. *
  281. * End of subroutine INCOR2
  282. *
  283. END
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  

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