Télécharger la plaquette Cast3M


fr en

Télécharger relr1d.eso

Retour à la liste

Numérotation des lignes : 

relr1d

  1. C RELR1D    SOURCE    GOUNAND   12/07/23    21:15:06     7441
  2.       SUBROUTINE RELR1D(MINCP,KRSPGP,KRINCP,
  3.      $     MINCD,KRSPGD,KRINCD,
  4.      $     COEF,MEL,DES,XMAT,
  5.      $     PROFM,
  6.      $     VALM,
  7.      $     IMPR,IRET)
  8.       IMPLICIT REAL*8 (A-H,O-Z)
  9.       IMPLICIT INTEGER (I-N)
  10. C***********************************************************************
  11. C NOM         : RELR1D
  12. C DESCRIPTION :
  13. * Compléter les valeurs de la matrice morse avec celles
  14. * de XMAT
  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, 01/07/2003, version initiale
  35. C HISTORIQUE : v1, 01/07/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. *      POINTEUR IMAT.IMATRI
  49.       POINTEUR XMAT.XMATRI
  50. -INC SMELEME
  51.       POINTEUR MEL.MELEME
  52. * Includes persos
  53. CBEGININCLUDE SMMINC
  54.       SEGMENT MINC
  55.       INTEGER     NPOS(NPT+1)
  56.       INTEGER     MPOS(NPT,NBI+1)
  57.       ENDSEGMENT
  58.       SEGMENT IMINC
  59.       INTEGER LNUPO (NDDL)
  60.       INTEGER LNUINC(NDDL)
  61.       ENDSEGMENT
  62. CENDINCLUDE SMMINC
  63.       POINTEUR MINCP.MINC
  64.       POINTEUR MINCD.MINC
  65. CBEGININCLUDE SMPMORS
  66.       SEGMENT PMORS
  67.       INTEGER IA (NTT+1)
  68.       INTEGER JA (NJA)
  69.       ENDSEGMENT
  70. CENDINCLUDE SMPMORS
  71.       POINTEUR PROFM.PMORS
  72. CBEGININCLUDE SMIZA
  73.       SEGMENT IZA
  74.       REAL*8  A(NBVA)
  75.       ENDSEGMENT
  76. CENDINCLUDE SMIZA
  77.       POINTEUR VALM.IZA
  78. *
  79. -INC SMLENTI
  80.       POINTEUR KJSPGP.MLENTI
  81.       POINTEUR KJSPGD.MLENTI
  82.       POINTEUR KRSPGP.MLENTI
  83.       POINTEUR KRSPGD.MLENTI
  84.       POINTEUR KRINCP.MLENTI
  85.       POINTEUR KRINCD.MLENTI
  86. *
  87.       INTEGER IMPR,IRET
  88. *
  89. * Executable statements
  90. *
  91.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr1d.eso'
  92.       NEL=MEL.NUM(/2)
  93. *      NEL2=IMAT.IMATTT(/1)
  94.       NEL2=XMAT.RE(/3)
  95.       IF (NEL.NE.NEL2) THEN
  96.          WRITE(IOIMP,*) 'Erreur grave no1'
  97.          GOTO 9999
  98.       ENDIF
  99.       NLIGRP=DES.NOELEP(/1)
  100.       NLIGRD=DES.NOELED(/1)
  101.       DO IEL=1,NEL
  102. *         XMAT=IMAT.IMATTT(IEL)
  103. *         SEGACT XMAT
  104.          DO ILIGRD=1,NLIGRD
  105.             IPODU=KRSPGD.LECT(MEL.NUM(DES.NOELED(ILIGRD),IEL))
  106.             IINCDU=KRINCD.LECT(ILIGRD)
  107.             IPOSDU=MINCD.MPOS(IPODU,IINCDU)
  108.             IF (IPOSDU.EQ.0) THEN
  109.                WRITE(IOIMP,*) 'Erreur grave no1'
  110.                GOTO 9999
  111.             ENDIF
  112.             IDDLDU=MINCD.NPOS(IPODU)+IPOSDU-1
  113.             DO ILIGRP=1,NLIGRP
  114.                IPOPR=KRSPGP.LECT(MEL.NUM(DES.NOELEP(ILIGRP),IEL))
  115.                IINCPR=KRINCP.LECT(ILIGRP)
  116.                IPOSPR=MINCP.MPOS(IPOPR,IINCPR)
  117.                IF (IPOSPR.EQ.0) THEN
  118.                   WRITE(IOIMP,*) 'Erreur grave no2'
  119.                   GOTO 9999
  120.                ENDIF
  121.                IDDLPR=MINCP.NPOS(IPOPR)+IPOSPR-1
  122.                IBVA=PROFM.IA(IDDLDU)
  123.                LBVA=PROFM.IA(IDDLDU+1)-IBVA
  124. * A quel index du profil morse trouve-t-on le ddl IDDLPR ?
  125.                CALL IFIDIC(LBVA,PROFM.JA(IBVA),IDDLPR,
  126.      $              JBVA,
  127.      $              IMPR,IRET)
  128.                IF (IRET.NE.0) GOTO 9999
  129.                VALM.A(IBVA+JBVA-1)=
  130.      $              VALM.A(IBVA+JBVA-1)+
  131.      $              (COEF*XMAT.RE(ILIGRD,ILIGRP,IEL))
  132.             ENDDO
  133.          ENDDO
  134. *         WRITE(IOIMP,*) 'IEL=',IEL
  135. *         CALL ECMORS(PROFM,VALM,3)
  136. *         SEGDES XMAT
  137.       ENDDO
  138. *
  139. * Normal termination
  140. *
  141.       IRET=0
  142.       RETURN
  143. *
  144. * Format handling
  145. *
  146. *
  147. * Error handling
  148. *
  149.  9999 CONTINUE
  150.       IRET=1
  151.       WRITE(IOIMP,*) 'An error was detected in subroutine relr1d'
  152.       RETURN
  153. *
  154. * End of subroutine RELR1D
  155. *
  156.       END
  157.  
  158.  
  159.  
  160.  

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