Télécharger la plaquette Cast3M


fr en

Télécharger xty.eso

Retour à la liste

Numérotation des lignes : 

xty

  1. C XTY       SOURCE    KICH      06/03/17    21:17:51     5342
  2.       SUBROUTINE XTY
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C=======================================================================
  6. C   OPERATEUR YTX : EFFECTUE LE PRODUIT Y * X
  7. C     ON RETIRE DU CHPOINT LES MULT. DE LAGRANGE .
  8. C   SYNTAXE :  Z = XTY X Y LISMOTX LISMOTY
  9. C         Z : FLOTTANT
  10. C         X : OBJET DE TYPE CHPOINT
  11. C         Y : OBJET DE TYPE CHPOINT
  12. C   LISMOTX : OBJET DE TYPE LISTE MOTS QUI PRECISE LES INCONNUES
  13. C             DE X A PRENDRE EN COMPTE
  14. C   LISMOTY : OBJET DE TYPE LISTE MOTS QUI PRECISE LES INCONNUES
  15. C             DE Y CORRESPONDANTES
  16. C      EX : UX UY UZ  ET FX FY FZ POUR FAIRE LE PRODUIT U * F
  17. C
  18. C=======================================================================
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMLCHPO
  23. -INC SMLREEL
  24. C
  25. C     LECTURE D UN CHPOINT
  26. C
  27.       CALL LIROBJ('CHPOINT ',MCHPOI,0,IRETOU)
  28.       IF(IERR.NE.0) GO TO 5000
  29.       if (iretou.ne.0) then
  30.         CALL LIROBJ('CHPOINT ',ICH1,1,IRETOU)
  31.         IF(IERR.NE.0) GO TO 5000
  32.         CALL LIROBJ('LISTMOTS',MLMOTX,1,IRETOU)
  33.         IF(IERR.NE.0) GO TO 5000
  34.         CALL LIROBJ('LISTMOTS',MLMOTY,1,IRETOU)
  35.         IF(IERR.NE.0) GO TO 5000
  36.         CALL XTY1(MCHPOI,ICH1,MLMOTX,MLMOTY,XDRET)
  37.         IF(IERR.NE.0) GO TO 5000
  38.         CALL ECRREE(XDRET)
  39.       endif
  40.  
  41.       CALL LIROBJ('LISTCHPO',LMCHPO,0,IRETOU)
  42.       IF(IERR.NE.0) GO TO 5000
  43.       if (iretou.ne.0) then
  44.         CALL LIROBJ('LISTCHPOI',LICH1,1,IRETOU)
  45.         IF(IERR.NE.0) GO TO 5000
  46.         CALL LIROBJ('LISTMOTS',MLMOTX,1,IRETOU)
  47.         IF(IERR.NE.0) GO TO 5000
  48.         CALL LIROBJ('LISTMOTS',MLMOTY,1,IRETOU)
  49.         IF(IERR.NE.0) GO TO 5000
  50.  
  51.       MLCHP1 = lmchpo
  52.       segact mlchp1
  53.       n1 = mlchp1.ichpoi(/1)
  54.  
  55.       if (n1.le.0) call erreur(3)
  56.       if (ierr.ne.0) return
  57.       MLCHP2 = lich1
  58.       segact mlchp2
  59.  
  60.       jg = n1
  61.       segini mlreel
  62.  
  63.       do ic = 1,n1
  64.         mchpo1 = mlchp1.ichpoi(ic)
  65.         mchpo2 = mlchp2.ichpoi(ic)
  66.         CALL XTY1(MCHPO1,mchpo2,MLMOTX,MLMOTY,XDRET)
  67.       if (ierr.ne.0) return
  68.  
  69.         prog(ic) = xdret
  70.       enddo
  71.  
  72.         segdes mlchp1, mlchp2,mlreel
  73.         CALL ECROBJ('LISTREEL',mlreel)
  74.       endif
  75.  
  76.  5000 CONTINUE
  77.       RETURN
  78.       END
  79.  
  80.  
  81.  

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