Télécharger la plaquette Cast3M


fr en

Télécharger relr13.eso

Retour à la liste

Numérotation des lignes : 

relr13

  1. C RELR13    SOURCE    PV        20/03/30    21:23:57     10567          
  2.       SUBROUTINE RELR13(MLIN,KJSPGP,KJSPGD,LINCP,LINCD,
  3.      $     MINCP,MINCD,
  4.      $     IMPR,IRET)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.       IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM         : RELR13
  9. C DESCRIPTION :
  10. *
  11. * Construction des tableaux de correspondance ddl <-> (point, nom de
  12. * variable) :
  13. * - pour les inconnues primales : MINCP
  14. * - pour les inconnues duales   : MINCD
  15. *
  16. C
  17. C
  18. C
  19. C LANGAGE     : ESOPE
  20. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  21. C               mél : gounand@semt2.smts.cea.fr
  22. C***********************************************************************
  23. C APPELES          :
  24. C APPELES (E/S)    :
  25. C APPELES (BLAS)   :
  26. C APPELES (CALCUL) :
  27. C APPELE PAR       :
  28. C***********************************************************************
  29. C SYNTAXE GIBIANE    :
  30. C ENTREES            :
  31. C ENTREES/SORTIES    :
  32. C SORTIES            :
  33. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  34. C***********************************************************************
  35. C VERSION    : v1, 27/06/2003, version initiale
  36. C HISTORIQUE : v1, 27/06/2003, création
  37. C HISTORIQUE :
  38. C HISTORIQUE :
  39. C***********************************************************************
  40. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  41. C en cas de modification de ce sous-programme afin de faciliter
  42. C la maintenance !
  43. C***********************************************************************
  44.  
  45. -INC PPARAM
  46. -INC CCOPTIO
  47. -INC SMCOORD
  48. -INC SMRIGID
  49.       POINTEUR MLIN.MRIGID
  50.       POINTEUR DES.DESCR
  51. -INC SMELEME
  52.       POINTEUR MEL.MELEME
  53. * Includes persos
  54. CBEGININCLUDE SMMINC
  55.       SEGMENT MINC
  56.       INTEGER     NPOS(NPT+1)
  57.       INTEGER     MPOS(NPT,NBI+1)
  58.       ENDSEGMENT
  59.       SEGMENT IMINC
  60.       INTEGER LNUPO (NDDL)
  61.       INTEGER LNUINC(NDDL)
  62.       ENDSEGMENT
  63. CENDINCLUDE SMMINC
  64.       POINTEUR MINCP.MINC
  65.       POINTEUR MINCD.MINC
  66. *
  67. -INC SMLENTI
  68.       POINTEUR KJSPGP.MLENTI
  69.       POINTEUR KJSPGD.MLENTI
  70.       POINTEUR KRSPGP.MLENTI
  71.       POINTEUR KRSPGD.MLENTI
  72.       POINTEUR KRINCP.MLENTI
  73.       POINTEUR KRINCD.MLENTI
  74. -INC SMLMOTS
  75.       POINTEUR LINCP.MLMOTS
  76.       POINTEUR LINCD.MLMOTS
  77. *
  78.       INTEGER IMPR,IRET
  79. *
  80.       LOGICAL LEXIST
  81. *
  82. * Executable statements
  83. *
  84.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr13.eso'
  85.       SEGACT MLIN
  86.       NRIG=MLIN.IRIGEL(/2)
  87. *
  88. * Primale
  89. *
  90. *  Construction du segment de repérage dans l'ensemble des points
  91.       SEGACT KJSPGP
  92.       NPOPRI=KJSPGP.LECT(/1)
  93.       JG=nbpts
  94.       SEGINI KRSPGP
  95.       CALL RSETXI(KRSPGP.LECT,KJSPGP.LECT,NPOPRI)
  96.       SEGDES KJSPGP
  97.       SEGACT LINCP
  98.       NINCP=LINCP.MOTS(/2)
  99. *  Initialisation de MINCP
  100.       NPT=NPOPRI
  101.       NBI=NINCP
  102.       SEGINI MINCP
  103.       DO IRIG=1,NRIG
  104.          MEL=MLIN.IRIGEL(1,IRIG)
  105.          SEGACT MEL
  106.          NEL=MEL.NUM(/2)
  107.          DES=MLIN.IRIGEL(3,IRIG)
  108.          SEGACT DES
  109.          NDDL=DES.NOELEP(/1)
  110. *   Construction du segment de repérage dans les inconnues primales
  111.          JG=DES.LISINC(/2)
  112.          SEGINI KRINCP
  113.          CALL CREPER(DES.LISINC(/1),NDDL,NINCP,
  114.      $        DES.LISINC,LINCP.MOTS,
  115.      $        KRINCP.LECT,
  116.      $        IMPR,IRET)
  117.          IF (IRET.NE.0) GOTO 9999
  118.          DO IEL=1,NEL
  119.             DO IDDL=1,NDDL
  120.                IPO=KRSPGP.LECT(MEL.NUM(DES.NOELEP(IDDL),IEL))
  121.                IINC=KRINCP.LECT(IDDL)
  122. *    On cherche si l'inconnue n'existe pas déjà dans MPOS
  123.                LEXIST=(MINCP.MPOS(IPO,IINC).NE.0)
  124. *    Sinon, on la rajoute...
  125.                IF (.NOT.LEXIST) THEN
  126.                   NPOINC=MINCP.MPOS(IPO,NINCP+1)+1
  127.                   MINCP.MPOS(IPO,NINCP+1)=NPOINC
  128.                   MINCP.MPOS(IPO,IINC)   =NPOINC
  129.                ENDIF
  130.             ENDDO
  131.          ENDDO
  132.          SEGSUP KRINCP
  133.          SEGDES DES
  134.          SEGDES MEL
  135.       ENDDO
  136. *   Remplisssage de NPOS
  137.       MINCP.NPOS(1)=1
  138.       DO IPOPRI=1,NPOPRI
  139.          MINCP.NPOS(IPOPRI+1)=MINCP.NPOS(IPOPRI)
  140.      $        + MINCP.MPOS(IPOPRI,NINCP+1)
  141.       ENDDO
  142.       SEGDES MINCP
  143.       SEGDES LINCP
  144.       SEGSUP KRSPGP
  145. *
  146. * Duale (copie conforme de ci-dessus)
  147. *
  148. *  Construction du segment de repérage dans l'ensemble des points
  149.       SEGACT KJSPGD
  150.       NPODUA=KJSPGD.LECT(/1)
  151.       JG=nbpts
  152.       SEGINI KRSPGD
  153.       CALL RSETXI(KRSPGD.LECT,KJSPGD.LECT,NPODUA)
  154.       SEGDES KJSPGD
  155.       SEGACT LINCD
  156.       NINCD=LINCD.MOTS(/2)
  157. *  Initialisation de MINCP
  158.       NPT=NPODUA
  159.       NBI=NINCD
  160.       SEGINI MINCD
  161.       DO IRIG=1,NRIG
  162.          MEL=MLIN.IRIGEL(1,IRIG)
  163.          SEGACT MEL
  164.          NEL=MEL.NUM(/2)
  165.          DES=MLIN.IRIGEL(3,IRIG)
  166.          SEGACT DES
  167.          NDDL=DES.NOELED(/1)
  168. *   Construction du segment de repérage dans les inconnues primales
  169.          JG=DES.LISDUA(/2)
  170.          SEGINI KRINCD
  171.          CALL CREPER(DES.LISDUA(/1),NDDL,NINCD,
  172.      $        DES.LISDUA,LINCD.MOTS,
  173.      $        KRINCD.LECT,
  174.      $        IMPR,IRET)
  175.          IF (IRET.NE.0) GOTO 9999
  176.          DO IEL=1,NEL
  177.             DO IDDL=1,NDDL
  178.                IPO=KRSPGD.LECT(MEL.NUM(DES.NOELED(IDDL),IEL))
  179.                IINC=KRINCD.LECT(IDDL)
  180. *    On cherche si l'inconnue n'existe pas déjà dans MPOS
  181.                LEXIST=(MINCD.MPOS(IPO,IINC).NE.0)
  182. *    Sinon, on la rajoute...
  183.                IF (.NOT.LEXIST) THEN
  184.                   NPOINC=MINCD.MPOS(IPO,NINCD+1)+1
  185.                   MINCD.MPOS(IPO,NINCD+1)=NPOINC
  186.                   MINCD.MPOS(IPO,IINC)   =NPOINC
  187.                ENDIF
  188.             ENDDO
  189.          ENDDO
  190.          SEGSUP KRINCD
  191.          SEGDES DES
  192.          SEGDES MEL
  193.       ENDDO
  194. *   Remplisssage de NPOS
  195.       MINCD.NPOS(1)=1
  196.       DO IPODUA=1,NPODUA
  197.          MINCD.NPOS(IPODUA+1)=MINCD.NPOS(IPODUA)
  198.      $        + MINCD.MPOS(IPODUA,NINCD+1)
  199.       ENDDO
  200.       SEGDES MINCD
  201.       SEGDES LINCD
  202.       SEGSUP KRSPGD
  203.       SEGDES MLIN
  204. *
  205. * Normal termination
  206. *
  207.       IRET=0
  208.       RETURN
  209. *
  210. * Format handling
  211. *
  212. *
  213. * Error handling
  214. *
  215.  9999 CONTINUE
  216.       IRET=1
  217.       WRITE(IOIMP,*) 'An error was detected in subroutine relr13'
  218.       RETURN
  219. *
  220. * End of subroutine RELR13
  221. *
  222.       END
  223.  
  224.  
  225.  
  226.  

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