Télécharger la plaquette Cast3M


fr en

Télécharger ajmtk.eso

Retour à la liste

Numérotation des lignes : 

ajmtk

  1. C AJMTK     SOURCE    PV        20/09/26    21:15:04     10724          
  2.       SUBROUTINE AJMTK(GMS,MK,IMPR,IRET)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM         : AJMTK
  7. C DESCRIPTION : Ajoute à un objet matrice de type MATRIK, un objet
  8. C               matrice simplifiée de type GMATSI (voir définition du
  9. C               segment ci-dessous).
  10. C
  11. C
  12. C
  13. C LANGAGE     : ESOPE
  14. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  15. C               mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES          : -
  18. C APPELES (UTIL)   : RSETI : copie d'un tableau d'entiers.
  19. C APPELE PAR       : YLAP1{B,C,D,E}
  20. C***********************************************************************
  21. C ENTREES            : MS (type MATSIM) : objet matrice à ajouter.
  22. C ENTREES/SORTIES    : MK (type MATRIK) : en sortie, est égal à :
  23. C                                         MK (en entrée) + MS
  24. C SORTIES            : -
  25. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26. C***********************************************************************
  27. C VERSION    : v1, 03/08/2001, version initiale
  28. C HISTORIQUE : v1, 03/08/2001, création
  29. C HISTORIQUE :
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33. C en cas de modification de ce sous-programme afin de faciliter
  34. C la maintenance !
  35. C***********************************************************************
  36.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  40.       INTEGER NRIGE,NMATRI,NKID,NKMT
  41.       INTEGER NBSOUS,NBME
  42.       INTEGER NBEL,NP,MP
  43.       POINTEUR MK.MATRIK
  44.       POINTEUR IK.IMATRI
  45.       POINTEUR JK.IZAFM
  46. -INC SMELEME
  47.       INTEGER NBNN,NBELEM,NBREF
  48.       POINTEUR MAIPRI.MELEME
  49.       POINTEUR MAIDUA.MELEME
  50. *
  51. * Objet matrice élémentaire simplifié
  52. *
  53.       SEGMENT GMATSI
  54.       INTEGER POIPR1(NPP1,NEL1)
  55.       INTEGER POIDU1(1,NEL1)
  56.       INTEGER POIPR2(NPP2,NEL2)
  57.       INTEGER POIDU2(2,NEL2)
  58.       POINTEUR LMATSI(0).MATSIM
  59.       ENDSEGMENT
  60.       POINTEUR GMS.GMATSI
  61.       SEGMENT MATSIM
  62.       CHARACTER*8 NOMPRI,NOMDUA
  63.       REAL*8 VALMA1(1,NPP1,NEL1)
  64.       REAL*8 VALMA2(2,NPP2,NEL2)
  65.       ENDSEGMENT
  66.       POINTEUR MS.MATSIM
  67. *
  68.       INTEGER IMPR,IRET
  69. *
  70.       INTEGER IPOPR1,IPOPR2,IMAT,IELEM1,IELEM2
  71.       INTEGER NPOPR1,NPOPR2,NMAT,NELEM1,NELEM2
  72. *
  73. * Executable statements
  74. *
  75.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans ajmtk.eso'
  76.       SEGACT GMS
  77.       NPOPR1=GMS.POIPR1(/1)
  78.       NPOPR2=GMS.POIPR2(/1)
  79.       NELEM1=GMS.POIPR1(/2)
  80.       NELEM2=GMS.POIPR2(/2)
  81.       IF (NELEM1.GT.0) THEN
  82. *
  83. * Création du premier MATRIK
  84. *
  85. * Création de MAIPRI
  86.          NBNN=NPOPR1
  87.          NBELEM=NELEM1
  88.          NBSOUS=0
  89.          NBREF=0
  90.          SEGINI,MAIPRI
  91. C     ITYPEL=32 -> 'POLY'
  92.          MAIPRI.ITYPEL=32
  93.          CALL RSETI(MAIPRI.NUM,GMS.POIPR1,NPOPR1*NELEM1)
  94.          SEGDES MAIPRI
  95. * Création de MAIDUA
  96.          NBNN=1
  97.          NBELEM=NELEM1
  98.          NBSOUS=0
  99.          NBREF=0
  100.          SEGINI,MAIDUA
  101. C     ITYPEL=32 -> 'POLY'
  102.          MAIDUA.ITYPEL=32
  103.          CALL RSETI(MAIDUA.NUM,GMS.POIDU1,NELEM1)
  104.          SEGDES MAIDUA
  105. * Création de IK (noms d'inconnues+pointeurs sur valeurs des matrices
  106. *                 élémentaires)
  107.          NMAT=GMS.LMATSI(/1)
  108.          NBME=NMAT
  109.          NBSOUS=1
  110.          SEGINI IK
  111.          DO 1 IMAT=1,NMAT
  112.             MS=GMS.LMATSI(IMAT)
  113.             SEGACT MS
  114. * Création de JK (matrice élémentaire)
  115.             NBEL=NELEM1
  116.             NP=NPOPR1
  117.             MP=1
  118.             SEGINI JK
  119.             DO 12 IELEM1=1,NELEM1
  120.                DO 122 IPOPR1=1,NPOPR1
  121.                   JK.AM(IELEM1,IPOPR1,1)=MS.VALMA1(1,IPOPR1,IELEM1)
  122.  122           CONTINUE
  123.  12         CONTINUE
  124.             SEGDES JK
  125.             IK.LISPRI(IMAT)=MS.NOMPRI
  126.             IK.LISDUA(IMAT)=MS.NOMDUA
  127.             IK.LIZAFM(1,IMAT)=JK
  128.             SEGDES MS
  129.  1       CONTINUE
  130.          SEGDES IK
  131. * Mise à jour de MK (pointeurs sur les matrices élémentaires)
  132.          SEGACT MK*MOD
  133.          NMATRI=MK.IRIGEL(/2)+1
  134.          NRIGE=MK.IRIGEL(/1)
  135.          NKID=MK.KIDMAT(/1)
  136.          NKMT=MK.KKMMT(/1)
  137.          SEGADJ,MK
  138.          MK.IRIGEL(1,NMATRI)=MAIPRI
  139.          MK.IRIGEL(2,NMATRI)=MAIDUA
  140.          MK.IRIGEL(4,NMATRI)=IK
  141. *     Matrice rectangulaire
  142.          MK.IRIGEL(7,NMATRI)=3
  143.          SEGDES MK
  144.       ENDIF
  145.       IF (NELEM2.GT.0) THEN
  146. *
  147. * Création du deuxième MATRIK
  148. *
  149. * Création de MAIPRI
  150.          NBNN=NPOPR2
  151.          NBELEM=NELEM2
  152.          NBSOUS=0
  153.          NBREF=0
  154.          SEGINI,MAIPRI
  155. C     ITYPEL=32 -> 'POLY'
  156.          MAIPRI.ITYPEL=32
  157.          CALL RSETI(MAIPRI.NUM,GMS.POIPR2,NPOPR2*NELEM2)
  158.          SEGDES MAIPRI
  159. * Création de MAIDUA
  160.          NBNN=2
  161.          NBELEM=NELEM2
  162.          NBSOUS=0
  163.          NBREF=0
  164.          SEGINI,MAIDUA
  165. C     ITYPEL=32 -> 'POLY'
  166.          MAIDUA.ITYPEL=32
  167.          CALL RSETI(MAIDUA.NUM,GMS.POIDU2,2*NELEM2)
  168.          SEGDES MAIDUA
  169. * Création de IK (noms d'inconnues+pointeurs sur valeurs des matrices
  170. *                 élémentaires)
  171.          NMAT=GMS.LMATSI(/1)
  172.          NBME=NMAT
  173.          NBSOUS=1
  174.          SEGINI IK
  175.          DO 3 IMAT=1,NMAT
  176.             MS=GMS.LMATSI(IMAT)
  177.             SEGACT MS
  178. * Création de JK (matrice élémentaire)
  179.             NBEL=NELEM2
  180.             NP=NPOPR2
  181.             MP=2
  182.             SEGINI JK
  183.             DO 32 IELEM2=1,NELEM2
  184.                DO 322 IPOPR2=1,NPOPR2
  185.                   JK.AM(IELEM2,IPOPR2,1)=MS.VALMA2(1,IPOPR2,IELEM2)
  186.                   JK.AM(IELEM2,IPOPR2,2)=MS.VALMA2(2,IPOPR2,IELEM2)
  187.  322           CONTINUE
  188.  32         CONTINUE
  189.             SEGDES JK
  190.             IK.LISPRI(IMAT)=MS.NOMPRI
  191.             IK.LISDUA(IMAT)=MS.NOMDUA
  192.             IK.LIZAFM(1,IMAT)=JK
  193.             SEGDES MS
  194.  3       CONTINUE
  195.          SEGDES IK
  196.          SEGDES GMS
  197. * Mise à jour de MK (pointeurs sur les matrices élémentaires)
  198.          SEGACT MK*MOD
  199.          NMATRI=MK.IRIGEL(/2)+1
  200.          NRIGE=MK.IRIGEL(/1)
  201.          NKID=MK.KIDMAT(/1)
  202.          NKMT=MK.KKMMT(/1)
  203.          SEGADJ,MK
  204.          MK.IRIGEL(1,NMATRI)=MAIPRI
  205.          MK.IRIGEL(2,NMATRI)=MAIDUA
  206.          MK.IRIGEL(4,NMATRI)=IK
  207. *     Matrice rectangulaire
  208.          MK.IRIGEL(7,NMATRI)=3
  209.          SEGDES MK
  210.       ENDIF
  211. *
  212. * Normal termination
  213. *
  214.       IRET=0
  215.       RETURN
  216. *
  217. * Format handling
  218. *
  219. *
  220. * Error handling
  221. *
  222.  9999 CONTINUE
  223.       IRET=1
  224.       WRITE(IOIMP,*) 'An error was detected in subroutine ajmtk'
  225.       RETURN
  226. *
  227. * End of subroutine AJMTK
  228. *
  229.       END
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  

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