Télécharger la plaquette Cast3M


fr en

Télécharger relr1a.eso

Retour à la liste

Numérotation des lignes : 

relr1a

  1. C RELR1A    SOURCE    GOUNAND   11/05/24    21:15:58     6976
  2.       SUBROUTINE RELR1A(MINCD,KRSPGD,KRINCD,
  3.      $     MEL,DES,
  4.      $     DDDNUL,
  5.      $     IMPR,IRET)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.       IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM         : RELR1A
  10. C DESCRIPTION :
  11. *   construction de la correspondance :
  12. *   ieme ddl dual de la matrice assemblée <->
  13. *   (numéro d'élément, numéro ddl dual local)
  14. *   de la rigidité dans lesquels il apparait
  15. C
  16. C
  17. C
  18. C LANGAGE     : ESOPE
  19. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  20. C               mél : gounand@semt2.smts.cea.fr
  21. C***********************************************************************
  22. C APPELES          :
  23. C APPELES (E/S)    :
  24. C APPELES (BLAS)   :
  25. C APPELES (CALCUL) :
  26. C APPELE PAR       : RELR14
  27. C***********************************************************************
  28. C SYNTAXE GIBIANE    :
  29. C ENTREES            :
  30. C ENTREES/SORTIES    :
  31. C SORTIES            :
  32. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  33. C***********************************************************************
  34. C VERSION    : v1, 30/06/2003, version initiale
  35. C HISTORIQUE : v1, 30/06/2003, création
  36. C HISTORIQUE :
  37. C HISTORIQUE :
  38. C***********************************************************************
  39. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  40. C en cas de modification de ce sous-programme afin de faciliter
  41. C la maintenance !
  42. C***********************************************************************
  43.  
  44. -INC PPARAM
  45. -INC CCOPTIO
  46. -INC SMRIGID
  47.       POINTEUR DES.DESCR
  48. -INC SMELEME
  49.       POINTEUR MEL.MELEME
  50. * Includes persos
  51. CBEGININCLUDE SMMINC
  52.       SEGMENT MINC
  53.       INTEGER     NPOS(NPT+1)
  54.       INTEGER     MPOS(NPT,NBI+1)
  55.       ENDSEGMENT
  56.       SEGMENT IMINC
  57.       INTEGER LNUPO (NDDL)
  58.       INTEGER LNUINC(NDDL)
  59.       ENDSEGMENT
  60. CENDINCLUDE SMMINC
  61.       POINTEUR MINCD.MINC
  62. *     Segment LSTIND (liste séquentielle indexée)
  63.       SEGMENT LSTIND
  64.       INTEGER IDX(NBM+1)
  65.       INTEGER IELRIG(NBTVAL)
  66.       INTEGER ILIGR (NBTVAL)
  67.       ENDSEGMENT
  68.       POINTEUR DDDNUL.LSTIND
  69. *
  70. -INC SMLENTI
  71.       POINTEUR KRSPGD.MLENTI
  72.       POINTEUR KRINCD.MLENTI
  73.       POINTEUR DDDNOL.MLENTI
  74.       POINTEUR DDDIUL.MLENTI
  75. *
  76.       INTEGER IMPR,IRET
  77. *
  78. * Executable statements
  79. *
  80.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr1a.eso'
  81.       NPODUA=MINCD.NPOS(/1)-1
  82.       NDDLDU=MINCD.NPOS(NPODUA+1)-1
  83.       NEL=MEL.NUM(/2)
  84.       NDDLOD=DES.NOELED(/1)
  85. *
  86. *   Passe 1 : construction de la correspondance :
  87. *             ieme ddl dual  <-> nombre de fois qu'il
  88. *                                apparait dans MEL
  89. *             DDDNOL
  90. *
  91.       JG=NDDLDU
  92.       SEGINI DDDNOL
  93.       DO IEL=1,NEL
  94.          DO IDDLOD=1,NDDLOD
  95.             IPO=KRSPGD.LECT(MEL.NUM(DES.NOELED(IDDLOD),IEL))
  96.             IINC=KRINCD.LECT(IDDLOD)
  97.             IPOS=MINCD.MPOS(IPO,IINC)
  98.             IF (IPOS.EQ.0) THEN
  99.                WRITE(IOIMP,*) 'Erreur grave no1'
  100.                GOTO 9999
  101.             ENDIF
  102.             IDDLDU=MINCD.NPOS(IPO)+IPOS-1
  103.             DDDNOL.LECT(IDDLDU)=DDDNOL.LECT(IDDLDU)+1
  104.          ENDDO
  105.       ENDDO
  106. *
  107. *   Passe 2 : construction de la correspondance :
  108. *             ieme ddl dual <-> (numéro d'élément de MEL)
  109. *             DDDNUL
  110.       JG=NDDLDU
  111.       SEGINI DDDIUL
  112.       IDEPA=1
  113.       DO IDDLDU=1,NDDLDU
  114.          DDDIUL.LECT(IDDLDU)=IDEPA
  115.          IDEPA=IDEPA+DDDNOL.LECT(IDDLDU)
  116.       ENDDO
  117.       SEGSUP DDDNOL
  118.       NBM=NDDLDU
  119.       NBTVAL=IDEPA-1
  120.       SEGINI DDDNUL
  121.       DO IDDLDU=1,NDDLDU
  122.          DDDNUL.IDX(IDDLDU)=DDDIUL.LECT(IDDLDU)
  123.       ENDDO
  124.       DDDNUL.IDX(NDDLDU+1)=IDEPA
  125.       DO IEL=1,NEL
  126.          DO IDDLOD=1,NDDLOD
  127.             IPO=KRSPGD.LECT(MEL.NUM(DES.NOELED(IDDLOD),IEL))
  128.             IINC=KRINCD.LECT(IDDLOD)
  129.             IPOS=MINCD.MPOS(IPO,IINC)
  130.             IF (IPOS.EQ.0) THEN
  131.                WRITE(IOIMP,*) 'Erreur grave no2'
  132.                GOTO 9999
  133.             ENDIF
  134.             IDDLDU=MINCD.NPOS(IPO)+IPOS-1
  135.             IDXCOU=DDDIUL.LECT(IDDLDU)
  136.             DDDNUL.IELRIG(IDXCOU)=IEL
  137.             DDDNUL.ILIGR (IDXCOU)=IDDLOD
  138.             DDDIUL.LECT(IDDLDU)=IDXCOU+1
  139.          ENDDO
  140.       ENDDO
  141.       SEGSUP DDDIUL
  142.       SEGDES DDDNUL
  143. *
  144. * Normal termination
  145. *
  146.       IRET=0
  147.       RETURN
  148. *
  149. * Format handling
  150. *
  151. *
  152. * Error handling
  153. *
  154.  9999 CONTINUE
  155.       IRET=1
  156.       WRITE(IOIMP,*) 'An error was detected in subroutine relr1a'
  157.       RETURN
  158. *
  159. * End of subroutine RELR1A
  160. *
  161.       END
  162.  
  163.  
  164.  

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