Télécharger la plaquette Cast3M


fr en

Télécharger relr14.eso

Retour à la liste

Numérotation des lignes : 

relr14

  1. C RELR14    SOURCE    PV        20/03/30    21:23:59     10567          
  2.       SUBROUTINE RELR14(MLIN,KJSPGP,KJSPGD,LINCP,LINCD,
  3.      $     MINCP,MINCD,
  4.      $     PROFM,VALM,
  5.      $     IMPR,IRET)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.       IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM         : RELR14
  10. C DESCRIPTION :
  11. *
  12. * Construction du profil Morse de la matrice assemblée
  13. * Celui-ci est ordonné (les numeros de colonnes
  14. * dans IA sont en ordre croissant)
  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. *      POINTEUR IMAT.IMATRI
  52.       POINTEUR XMAT.XMATRI
  53. -INC SMELEME
  54.       POINTEUR MEL.MELEME
  55. * Includes persos
  56. CBEGININCLUDE SMMINC
  57.       SEGMENT MINC
  58.       INTEGER     NPOS(NPT+1)
  59.       INTEGER     MPOS(NPT,NBI+1)
  60.       ENDSEGMENT
  61.       SEGMENT IMINC
  62.       INTEGER LNUPO (NDDL)
  63.       INTEGER LNUINC(NDDL)
  64.       ENDSEGMENT
  65. CENDINCLUDE SMMINC
  66.       POINTEUR MINCP.MINC
  67.       POINTEUR MINCD.MINC
  68. CBEGININCLUDE SMPMORS
  69.       SEGMENT PMORS
  70.       INTEGER IA (NTT+1)
  71.       INTEGER JA (NJA)
  72.       ENDSEGMENT
  73. CENDINCLUDE SMPMORS
  74.       POINTEUR PROFM.PMORS
  75.       POINTEUR PMCOU.PMORS
  76.       POINTEUR PMTMP.PMORS
  77. CBEGININCLUDE SMIZA
  78.       SEGMENT IZA
  79.       REAL*8  A(NBVA)
  80.       ENDSEGMENT
  81. CENDINCLUDE SMIZA
  82.       POINTEUR VALM.IZA
  83. *     Segment LSTIND (liste séquentielle indexée)
  84.       SEGMENT LSTIND
  85.       INTEGER IDX(NBM+1)
  86.       INTEGER IELRIG(NBTVAL)
  87.       INTEGER ILIGR (NBTVAL)
  88.       ENDSEGMENT
  89.       POINTEUR DDDNUL.LSTIND
  90. *
  91. -INC SMLENTI
  92.       POINTEUR KJSPGP.MLENTI
  93.       POINTEUR KJSPGD.MLENTI
  94.       POINTEUR KRSPGP.MLENTI
  95.       POINTEUR KRSPGD.MLENTI
  96.       POINTEUR KRINCP.MLENTI
  97.       POINTEUR KRINCD.MLENTI
  98. -INC SMLMOTS
  99.       POINTEUR LINCP.MLMOTS
  100.       POINTEUR LINCD.MLMOTS
  101. *
  102.       INTEGER IMPR,IRET
  103. *
  104.       LOGICAL LEXIST
  105. *
  106. * Executable statements
  107. *
  108.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr14.eso'
  109.       SEGACT MLIN
  110.       NRIG=MLIN.IRIGEL(/2)
  111. *  Construction des segments de repérage dans l'ensemble des points
  112.       SEGACT KJSPGP
  113.       NPOPRI=KJSPGP.LECT(/1)
  114.       JG=nbpts
  115.       SEGINI KRSPGP
  116.       CALL RSETXI(KRSPGP.LECT,KJSPGP.LECT,NPOPRI)
  117.       SEGDES KJSPGP
  118.       SEGACT LINCP
  119.       NINCP=LINCP.MOTS(/2)
  120.       SEGACT MINCP
  121. *
  122.       SEGACT KJSPGD
  123.       NPODUA=KJSPGD.LECT(/1)
  124.       JG=nbpts
  125.       SEGINI KRSPGD
  126.       CALL RSETXI(KRSPGD.LECT,KJSPGD.LECT,NPODUA)
  127.       SEGDES KJSPGD
  128.       SEGACT LINCD
  129.       NINCD=LINCD.MOTS(/2)
  130.       SEGACT MINCD
  131. *  Initialisation du profil morse total (profil vide et non diagonal)
  132.       NDDLPR=MINCP.NPOS(NPOPRI+1)-1
  133.       NDDLDU=MINCD.NPOS(NPODUA+1)-1
  134.       NTT=NDDLDU
  135.       NJA=0
  136.       SEGINI PROFM
  137.       DO I=1,NDDLDU+1
  138.          PROFM.IA(I)=1
  139.       ENDDO
  140.       SEGDES PROFM
  141.       DO IRIG=1,NRIG
  142.          MEL=MLIN.IRIGEL(1,IRIG)
  143.          SEGACT MEL
  144. * a effacer         NEL=MEL.NUM(/2)
  145.          DES=MLIN.IRIGEL(3,IRIG)
  146.          SEGACT DES
  147.          NDDLOP=DES.NOELEP(/1)
  148.          NDDLOD=DES.NOELED(/1)
  149. *   Construction du segment de repérage dans les inconnues primales et duales
  150.          JG=NDDLOP
  151.          SEGINI KRINCP
  152.          CALL CREPER(DES.LISINC(/1),NDDLOP,NINCP,
  153.      $        DES.LISINC,LINCP.MOTS,
  154.      $        KRINCP.LECT,
  155.      $        IMPR,IRET)
  156.          IF (IRET.NE.0) GOTO 9999
  157.          JG=NDDLOD
  158.          SEGINI KRINCD
  159.          CALL CREPER(DES.LISDUA(/1),NDDLOD,NINCD,
  160.      $        DES.LISDUA,LINCD.MOTS,
  161.      $        KRINCD.LECT,
  162.      $        IMPR,IRET)
  163.          IF (IRET.NE.0) GOTO 9999
  164. *   construction de la correspondance :
  165. *   ieme ddl dual de la matrice assemblée <->
  166. *   (numéro d'élément, numéro ddl dual local)
  167. *   de la rigidité dans lesquels il apparait
  168. *     In relr1a : SEGINI DDDNUL
  169.          CALL RELR1A(MINCD,KRSPGD,KRINCD,
  170.      $        MEL,DES,
  171.      $        DDDNUL,
  172.      $        IMPR,IRET)
  173.          IF (IRET.NE.0) GOTO 9999
  174. * a effacer         SEGPRT,DDDNUL
  175. *   construction de la correspondance :
  176. *   ieme ddl dual de la matrice assemblée <->
  177. *   (numéros des ddl primaux avec lesquels il est
  178. *   en relation). C'est le profil morse (non ordonné)
  179. *     In relr1b : SEGINI PMCOU
  180.          CALL RELR1B(DDDNUL,
  181.      $        MINCP,KRSPGP,KRINCP,
  182.      $        MEL,DES,
  183.      $        PMCOU,
  184.      $        IMPR,IRET)
  185.          IF (IRET.NE.0) GOTO 9999
  186. *         WRITE(IOIMP,*) ' ',IRIG
  187. *         WRITE(IOIMP,*) 'IRIG=',IRIG
  188. *         WRITE(IOIMP,*) ' ',IRIG
  189. *         CALL ECMORS(PMCOU,0,3)
  190. * a effacer         SEGPRT,PMCOU
  191. * In FUSPRM : SEGINI PMTMP
  192.          CALL FUSPR2(PROFM,PMCOU,NDDLPR,
  193.      $        PMTMP,
  194.      $        IMPR,IRET)
  195.          IF (IRET.NE.0) GOTO 9999
  196. *         CALL ECMORS(PMTMP,0,3)
  197.          SEGSUP PMCOU
  198.          SEGSUP PROFM
  199.          PROFM=PMTMP
  200.          SEGSUP DDDNUL
  201.          SEGSUP KRINCD
  202.          SEGSUP KRINCP
  203.          SEGDES DES
  204.          SEGDES MEL
  205.       ENDDO
  206. *
  207. * Ordonnancement du profil morse
  208. *
  209.       CALL RELR1C(PROFM,NDDLPR,
  210.      $     IMPR,IRET)
  211.       IF (IRET.NE.0) GOTO 9999
  212. *      SEGPRT,PROFM
  213. *
  214. * Remplissage des valeurs de la matrice Morse
  215. *
  216.       SEGACT PROFM
  217.       NNZ=PROFM.JA(/1)
  218.       NBVA=NNZ
  219.       SEGINI VALM
  220.       DO IRIG=1,NRIG
  221.          COEF=MLIN.COERIG(IRIG)
  222.          MEL=MLIN.IRIGEL(1,IRIG)
  223.          SEGACT MEL
  224. * a effacer         NEL=MEL.NUM(/2)
  225.          DES=MLIN.IRIGEL(3,IRIG)
  226.          SEGACT DES
  227.          NDDLOP=DES.NOELEP(/1)
  228.          NDDLOD=DES.NOELED(/1)
  229. *   Construction du segment de repérage dans les inconnues primales et duales
  230.          JG=NDDLOP
  231.          SEGINI KRINCP
  232.          CALL CREPER(DES.LISINC(/1),NDDLOP,NINCP,
  233.      $        DES.LISINC,LINCP.MOTS,
  234.      $        KRINCP.LECT,
  235.      $        IMPR,IRET)
  236.          IF (IRET.NE.0) GOTO 9999
  237.          JG=NDDLOD
  238.          SEGINI KRINCD
  239.          CALL CREPER(DES.LISDUA(/1),NDDLOD,NINCD,
  240.      $        DES.LISDUA,LINCD.MOTS,
  241.      $        KRINCD.LECT,
  242.      $        IMPR,IRET)
  243.          IF (IRET.NE.0) GOTO 9999
  244. *         IMAT=MLIN.IRIGEL(4,IRIG)
  245. *         SEGACT IMAT
  246.          XMAT=MLIN.IRIGEL(4,IRIG)
  247.          SEGACT XMAT
  248. * Compléter les valeurs de la matrice morse avec celles
  249. * de XMAT
  250.          CALL RELR1D(MINCP,KRSPGP,KRINCP,
  251.      $        MINCD,KRSPGD,KRINCD,
  252.      $        COEF,MEL,DES,XMAT,
  253.      $        PROFM,
  254.      $        VALM,
  255.      $        IMPR,IRET)
  256.          IF (IRET.NE.0) GOTO 9999
  257. *         WRITE(IOIMP,*) 'IRIG=',IRIG
  258. *         CALL ECMORS(PROFM,VALM,3)
  259. *         stop 16
  260.  
  261. *         SEGDES IMAT
  262.          SEGDES XMAT
  263.          SEGSUP KRINCD
  264.          SEGSUP KRINCP
  265.          SEGDES DES
  266.          SEGDES MEL
  267.       ENDDO
  268.       SEGDES VALM
  269.       SEGDES PROFM
  270.       SEGDES MINCD
  271.       SEGDES LINCD
  272.       SEGSUP KRSPGD
  273.       SEGDES MINCP
  274.       SEGDES LINCP
  275.       SEGSUP KRSPGP
  276.       SEGDES MLIN
  277. *
  278. * Normal termination
  279. *
  280.       IRET=0
  281.       RETURN
  282. *
  283. * Format handling
  284. *
  285. *
  286. * Error handling
  287. *
  288.  9999 CONTINUE
  289.       IRET=1
  290.       WRITE(IOIMP,*) 'An error was detected in subroutine relr14'
  291.       RETURN
  292. *
  293. * End of subroutine RELR14
  294. *
  295.       END
  296.  
  297.  
  298.  
  299.  
  300.  

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