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    PV        20/09/26    21:17:24     10724          
  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.          ENDIF
  137.       ENDDO
  138.       DO IMATE=1,NMATE
  139.          IMATYP=MATELE.IRIGEL(7,IMATE)
  140.          IF (IMATYP.EQ.4.OR.IMATYP.EQ.-3.OR.IMATYP.EQ.-4) THEN
  141.             IMATEL=MATELE.IRIGEL(4,IMATE)
  142.             SEGACT IMATEL
  143.             DO IBME=1,IMATEL.LISDUA(/2)
  144.                MONMOT=IMATEL.LISDUA(IBME)
  145.                CALL FIMOTS(MONMOT,LITOT,IORD,IMPR,IRET)
  146.                IF (IRET.NE.0) GOTO 9999
  147.                IF (IMATYP.EQ.-4) THEN
  148.                   LITYP.LECT(IORD)=4
  149.                ELSE
  150.                   LITYP.LECT(IORD)=3
  151.                ENDIF
  152.             ENDDO
  153.             SEGDES IMATEL
  154.          ENDIF
  155.       ENDDO
  156. *      SEGPRT,LITYP
  157. *
  158. * On construit LINIV
  159. *
  160.       JG=LITOT.MOTS(/2)
  161.       SEGINI LINIV
  162. * On fait d'abord les types trusted et untrusted
  163.       DO ITYP=1,2
  164.          DO IINC=1,LITOT.MOTS(/2)
  165.             IF (LITYP.LECT(IINC).EQ.ITYP) THEN
  166.                LINIV.LECT(IINC)=1
  167.             ENDIF
  168.          ENDDO
  169.       ENDDO
  170. * Les inconnues qui ont le type muliplicateur de Lagrange
  171. * mais qui n'ont de relations qu'avec elles-memes
  172. * se font attribuer un niveau 1.
  173.       DO ITYP=3,4
  174.          DO IINC=1,LITOT.MOTS(/2)
  175.             IF (LITYP.LECT(IINC).EQ.ITYP) THEN
  176.                MONMOD=LITOT.MOTS(IINC)
  177.                LRELA=.TRUE.
  178.                DO IMATE=1,NMATE
  179.                   IMATEL=MATELE.IRIGEL(4,IMATE)
  180.                   SEGACT IMATEL
  181.                   DO IBME=1,IMATEL.LISDUA(/2)
  182.                      IF (IMATEL.LISDUA(IBME).EQ.MONMOD) THEN
  183.                         MONMOP=IMATEL.LISPRI(IBME)
  184. *rajout 10/04/2009
  185.                         CALL FIMOTS(MONMOP,LITOT,IORP,IMPR,IRET)
  186.                         IF (IRET.NE.0) GOTO 9999
  187.                         ITYPP=LITYP.LECT(IORP)
  188.                         IF (MONMOP.NE.MONMOD.AND.(ITYPP.NE.ITYP)) THEN
  189. *                        IF (.NOT.(MONMOP.EQ.MONMOD)) THEN
  190.                            LRELA=.FALSE.
  191.                         ENDIF
  192.                      ENDIF
  193.                   ENDDO
  194.                   SEGDES IMATEL
  195.                ENDDO
  196.                IF (LRELA) THEN
  197. *                  LIORD.LECT(IINC)=IORD
  198. *                  IORD=IORD+1
  199.                   LINIV.LECT(IINC)=1
  200.                ENDIF
  201.             ENDIF
  202.          ENDDO
  203.       ENDDO
  204.       SEGDES LITYP
  205. *
  206. *      WRITE(IOIMP,*) ' Coucou les gars'
  207. *
  208. *      SEGPRT,LITOT
  209. *      SEGPRT,LINIV
  210. *      SEGPRT,LIORD
  211. *      SEGPRT,LIORD
  212. * On s'occupe des inconnues n'ayant pas de niveau.
  213.       NLAG=0
  214.       DO IINC=1,LITOT.MOTS(/2)
  215.          INIV=LINIV.LECT(IINC)
  216.          IF (INIV.EQ.0) THEN
  217.             NLAG=NLAG+1
  218.          ENDIF
  219.       ENDDO
  220. *
  221. *      WRITE(IOIMP,*) 'NLAG=',NLAG
  222. *
  223.       DO IBCL=1,LITOT.MOTS(/2)
  224. * 9    CONTINUE
  225.       IF (NLAG.GT.0) THEN
  226.          DO IINC=1,LITOT.MOTS(/2)
  227.             INIV=LINIV.LECT(IINC)
  228.             IF (INIV.EQ.0) THEN
  229.                MONMOD=LITOT.MOTS(IINC)
  230. *               WRITE(IOIMP,*) 'IINC=',IINC
  231. *               WRITE(IOIMP,*) 'MONMOD=',MONMOD
  232.                LOK=.FALSE.
  233.                DO IMATE=1,NMATE
  234.                   IMATEL=MATELE.IRIGEL(4,IMATE)
  235.                   SEGACT IMATEL
  236.                   DO IBME=1,IMATEL.LISDUA(/2)
  237.                      IF (IMATEL.LISDUA(IBME).EQ.MONMOD) THEN
  238.                         MONMOP=IMATEL.LISPRI(IBME)
  239.                         IF (MONMOP.NE.MONMOD) THEN
  240.                            CALL FIMOTS(MONMOP,LITOT,JINC,IMPR,IRET)
  241.                            IF (IRET.NE.0) GOTO 9999
  242.                            KNIV=LINIV.LECT(JINC)
  243. *                           WRITE(IOIMP,*) 'MONMOP=',MONMOP
  244. *                           WRITE(IOIMP,*) 'KNIV=',KNIV
  245.                            IF (KNIV.NE.0) THEN
  246. *                              LOK=.FALSE.
  247. *                           ELSE
  248.                               LOK=.TRUE.
  249.                               INIV=MAX(INIV,KNIV+1)
  250.                            ENDIF
  251.                         ENDIF
  252.                      ENDIF
  253.                   ENDDO
  254.                   SEGDES IMATEL
  255.                ENDDO
  256. *               WRITE(IOIMP,*) 'LOK=',LOK
  257.                IF (LOK) THEN
  258.                   NLAG=NLAG-1
  259.                   LINIV.LECT(IINC)=INIV
  260.                ENDIF
  261.             ENDIF
  262.          ENDDO
  263. *        GOTO 9
  264.       ENDIF
  265.       ENDDO
  266.       SEGDES MATELE
  267.       SEGDES LINIV
  268. *
  269. * Normal termination
  270. *
  271.       IRET=0
  272.       RETURN
  273. *
  274. * Format handling
  275. *
  276. *
  277. * Error handling
  278. *
  279.  9999 CONTINUE
  280.       IRET=1
  281.       WRITE(IOIMP,*) 'An error was detected in subroutine incor2'
  282.       RETURN
  283. *
  284. * End of subroutine INCOR2
  285. *
  286.       END
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  

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