Télécharger la plaquette Cast3M


fr en

Télécharger incor2.eso

Retour à la liste

Numérotation des lignes : 

incor2

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

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