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.  
  47. -INC PPARAM
  48. -INC CCOPTIO
  49. POINTEUR MATELE.MATRIK
  50. POINTEUR IMATEL.IMATRI
  51. -INC SMLMOTS
  52. POINTEUR GPINCS.MLMOTS
  53. POINTEUR LITOT.MLMOTS
  54. POINTEUR LITOT2.MLMOTS
  55. -INC SMLENTI
  56. POINTEUR LINIV.MLENTI
  57. POINTEUR LINIV2.MLENTI
  58. POINTEUR LITYP.MLENTI
  59. POINTEUR LITYP2.MLENTI
  60. POINTEUR LORD.MLENTI
  61. POINTEUR LIORD.MLENTI
  62. C! POINTEUR LIORD2.MLENTI
  63. POINTEUR LIPERM.MLENTI
  64. LOGICAL LOK
  65. *
  66. INTEGER LNMOTS
  67. PARAMETER (LNMOTS=8)
  68. CHARACTER*8 MONMOT,MONMOD,MONMOP
  69. LOGICAL LRELA
  70. LOGICAL LTYNU2,LTYP1
  71. *
  72. INTEGER IMPR,IRET
  73. *
  74. * Executable statements
  75. *
  76. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans incor2.eso'
  77. LTYNU2=(IMULAG.EQ.4.OR.IMULAG.EQ.5)
  78. *
  79. SEGACT MATELE
  80. NMATE = MATELE.IRIGEL(/2)
  81. *
  82. * Construction de la liste des inconnues
  83. *
  84. NBMTOT=0
  85. DO 3 IMATE=1,NMATE
  86. IMATEL=MATELE.IRIGEL(4,IMATE)
  87. SEGACT IMATEL
  88. NBMTOT=NBMTOT+IMATEL.LISPRI(/2)
  89. SEGDES IMATEL
  90. 3 CONTINUE
  91. JGN=LNMOTS
  92. JGM=2*NBMTOT
  93. SEGINI GPINCS
  94. SEGINI LITOT
  95. NBM2=0
  96. DO 4 IMATE=1,NMATE
  97. IMATEL=MATELE.IRIGEL(4,IMATE)
  98. SEGACT IMATEL
  99. DO 42 IBME=1,IMATEL.LISPRI(/2)
  100. NBM2=NBM2+1
  101. GPINCS.MOTS(NBM2)=IMATEL.LISPRI(IBME)
  102. 42 CONTINUE
  103. DO 43 IBME=1,IMATEL.LISDUA(/2)
  104. NBM2=NBM2+1
  105. GPINCS.MOTS(NBM2)=IMATEL.LISDUA(IBME)
  106. 43 CONTINUE
  107. SEGDES IMATEL
  108. 4 CONTINUE
  109. CALL CUNIQ(GPINCS.MOTS,LNMOTS,NBM2,
  110. $ LITOT.MOTS,NBUNIQ,
  111. $ IMPR,IRET)
  112. IF (IRET.NE.0) GOTO 9999
  113. JGN=LNMOTS
  114. JGM=NBUNIQ
  115. SEGADJ LITOT
  116. SEGSUP GPINCS
  117. *
  118. * SEGPRT,LITOT
  119. *
  120. * Construction de la liste des types
  121. JG=LITOT.MOTS(/2)
  122. SEGINI LITYP
  123. * Par défaut, toutes les inconnues ont le type untrusted (2)
  124. DO IORD=1,LITYP.LECT(/1)
  125. LITYP.LECT(IORD)=2
  126. ENDDO
  127. * On parcourt la liste des noms pour donner un type trusted (1)
  128. * ou multiplicateur de Lagrange premier (3) ou deuxième (4).
  129. DO ITOT=1,LITOT.MOTS(/2)
  130. * IF (LITOT.MOTS(ITOT)(1:1).EQ.'$') THEN
  131. * LITYP.LECT(ITOT)=1
  132. * ELSEIF (LITOT.MOTS(ITOT)(1:2).EQ.'LX') THEN
  133. IF (LITOT.MOTS(ITOT)(1:2).EQ.'LX') THEN
  134. LITYP.LECT(ITOT)=3
  135. ENDIF
  136. ENDDO
  137. DO IMATE=1,NMATE
  138. IMATYP=MATELE.IRIGEL(7,IMATE)
  139. IF (IMATYP.EQ.4.OR.IMATYP.EQ.-3.OR.IMATYP.EQ.-4) THEN
  140. IMATEL=MATELE.IRIGEL(4,IMATE)
  141. SEGACT IMATEL
  142. DO IBME=1,IMATEL.LISDUA(/2)
  143. MONMOT=IMATEL.LISDUA(IBME)
  144. CALL FIMOTS(MONMOT,LITOT,IORD,IMPR,IRET)
  145. IF (IRET.NE.0) GOTO 9999
  146. IF (IMATYP.EQ.-4) THEN
  147. LITYP.LECT(IORD)=4
  148. ELSE
  149. LITYP.LECT(IORD)=3
  150. ENDIF
  151. ENDDO
  152. SEGDES IMATEL
  153. ENDIF
  154. ENDDO
  155. * SEGPRT,LITYP
  156. *
  157. * On construit LINIV
  158. *
  159. JG=LITOT.MOTS(/2)
  160. SEGINI LINIV
  161. * On fait d'abord les types trusted et untrusted
  162. DO ITYP=1,2
  163. DO IINC=1,LITOT.MOTS(/2)
  164. IF (LITYP.LECT(IINC).EQ.ITYP) THEN
  165. LINIV.LECT(IINC)=1
  166. ENDIF
  167. ENDDO
  168. ENDDO
  169. * Les inconnues qui ont le type muliplicateur de Lagrange
  170. * mais qui n'ont de relations qu'avec elles-memes
  171. * se font attribuer un niveau 1.
  172. DO ITYP=3,4
  173. DO IINC=1,LITOT.MOTS(/2)
  174. IF (LITYP.LECT(IINC).EQ.ITYP) THEN
  175. MONMOD=LITOT.MOTS(IINC)
  176. LRELA=.TRUE.
  177. DO IMATE=1,NMATE
  178. IMATEL=MATELE.IRIGEL(4,IMATE)
  179. SEGACT IMATEL
  180. DO IBME=1,IMATEL.LISDUA(/2)
  181. IF (IMATEL.LISDUA(IBME).EQ.MONMOD) THEN
  182. MONMOP=IMATEL.LISPRI(IBME)
  183. *rajout 10/04/2009
  184. CALL FIMOTS(MONMOP,LITOT,IORP,IMPR,IRET)
  185. IF (IRET.NE.0) GOTO 9999
  186. ITYPP=LITYP.LECT(IORP)
  187. IF (MONMOP.NE.MONMOD.AND.(ITYPP.NE.ITYP)) THEN
  188. * IF (.NOT.(MONMOP.EQ.MONMOD)) THEN
  189. LRELA=.FALSE.
  190. ENDIF
  191. ENDIF
  192. ENDDO
  193. SEGDES IMATEL
  194. ENDDO
  195. IF (LRELA) THEN
  196. * LIORD.LECT(IINC)=IORD
  197. * IORD=IORD+1
  198. LINIV.LECT(IINC)=1
  199. ENDIF
  200. ENDIF
  201. ENDDO
  202. ENDDO
  203. SEGDES LITYP
  204. *
  205. * WRITE(IOIMP,*) ' Coucou les gars'
  206. *
  207. * SEGPRT,LITOT
  208. * SEGPRT,LINIV
  209. * SEGPRT,LIORD
  210. * SEGPRT,LIORD
  211. * On s'occupe des inconnues n'ayant pas de niveau.
  212. NLAG=0
  213. DO IINC=1,LITOT.MOTS(/2)
  214. INIV=LINIV.LECT(IINC)
  215. IF (INIV.EQ.0) THEN
  216. NLAG=NLAG+1
  217. ENDIF
  218. ENDDO
  219. *
  220. * WRITE(IOIMP,*) 'NLAG=',NLAG
  221. *
  222. DO IBCL=1,LITOT.MOTS(/2)
  223. * 9 CONTINUE
  224. IF (NLAG.GT.0) THEN
  225. DO IINC=1,LITOT.MOTS(/2)
  226. INIV=LINIV.LECT(IINC)
  227. IF (INIV.EQ.0) THEN
  228. MONMOD=LITOT.MOTS(IINC)
  229. * WRITE(IOIMP,*) 'IINC=',IINC
  230. * WRITE(IOIMP,*) 'MONMOD=',MONMOD
  231. LOK=.FALSE.
  232. DO IMATE=1,NMATE
  233. IMATEL=MATELE.IRIGEL(4,IMATE)
  234. SEGACT IMATEL
  235. DO IBME=1,IMATEL.LISDUA(/2)
  236. IF (IMATEL.LISDUA(IBME).EQ.MONMOD) THEN
  237. MONMOP=IMATEL.LISPRI(IBME)
  238. IF (MONMOP.NE.MONMOD) THEN
  239. CALL FIMOTS(MONMOP,LITOT,JINC,IMPR,IRET)
  240. IF (IRET.NE.0) GOTO 9999
  241. KNIV=LINIV.LECT(JINC)
  242. * WRITE(IOIMP,*) 'MONMOP=',MONMOP
  243. * WRITE(IOIMP,*) 'KNIV=',KNIV
  244. IF (KNIV.NE.0) THEN
  245. * LOK=.FALSE.
  246. * ELSE
  247. LOK=.TRUE.
  248. INIV=MAX(INIV,KNIV+1)
  249. ENDIF
  250. ENDIF
  251. ENDIF
  252. ENDDO
  253. SEGDES IMATEL
  254. ENDDO
  255. * WRITE(IOIMP,*) 'LOK=',LOK
  256. IF (LOK) THEN
  257. NLAG=NLAG-1
  258. LINIV.LECT(IINC)=INIV
  259. ENDIF
  260. ENDIF
  261. ENDDO
  262. * GOTO 9
  263. ENDIF
  264. ENDDO
  265. SEGDES MATELE
  266. SEGDES LINIV
  267. *
  268. * Normal termination
  269. *
  270. IRET=0
  271. RETURN
  272. *
  273. * Format handling
  274. *
  275. *
  276. * Error handling
  277. *
  278. 9999 CONTINUE
  279. IRET=1
  280. WRITE(IOIMP,*) 'An error was detected in subroutine incor2'
  281. RETURN
  282. *
  283. * End of subroutine INCOR2
  284. *
  285. END
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  

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