Télécharger la plaquette Cast3M


fr en

Télécharger biosav.eso

Retour à la liste

Numérotation des lignes : 

biosav

  1. C BIOSAV    SOURCE    CB215821  25/03/25    21:15:04     12217          
  2.       SUBROUTINE BIOSAV
  3. C----------------------------------------------------------
  4. C
  5. C           CALCUL DES CHAMPS DE BIOT ET SAVART
  6. C
  7. C----------------------------------------------------------
  8.       IMPLICIT INTEGER(I-N)
  9.       IMPLICIT REAL*8(A-H,O-Z)
  10.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. -INC CCREEL
  14. -INC SMELEME
  15. -INC SMCOORD
  16. -INC TMTRAV
  17. -INC SMCHPOI
  18. -INC SMMODEL
  19. -INC SMCHAML
  20.       INTEGER ENT
  21.       DIMENSION C(3),PN1(3),RESP(3)
  22.       DIMENSION VX(3),VZ(3),VY(3),VI(3),PP3(3)
  23.       DIMENSION ZF1(1),ZALF(1),ZDENS(1),ZBET(1)
  24.       DIMENSION P1(3),P2(3),P3(3),ROTA(3,3)
  25.       SEGMENT ICPR(NBPTS)
  26.  
  27.       SEGMENT SANGLE
  28.         REAL*8 TETM(NT4)
  29.         REAL*8 TETI(NT4)
  30.         REAL*8 DTE(NT4)
  31.       ENDSEGMENT
  32. C
  33.       CHARACTER*4 MCLE(4),CHSECT(1),CHOIX(2)
  34.       CHARACTER*8 LISUP(5),MOT
  35.       LOGICAL INDU,POTE,CHPO
  36. C
  37.       DATA EPSIL3/1.D-12/
  38. C
  39.       DATA LISUP / 'NOEUD   ','GRAVITE ','RIGIDITE','MASSE   ',
  40.      &             'STRESSES'/
  41.       DATA MCLE/'CERC','ARC ','BARR','FIL '/
  42.       DATA CHSECT/'TRAP'/
  43.       DATA CHOIX/'INDU','POTE'/
  44.  
  45.  
  46.       SEGACT MCOORD
  47.  
  48.  
  49. C     SYNTAXE 2 : AVEC UN CHPOINT
  50.       CALL LIROBJ('CHPOINT  ',MCHPO1,0,IRETOU)
  51.       IF (IERR.NE.0) RETURN
  52.  
  53.       IF (IRETOU.EQ.1) THEN
  54.         CALL ACTOBJ('CHPOINT  ',MCHPO1,1)
  55.         IF (IERR.NE.0) RETURN
  56.  
  57.         CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  58.         IF (IERR.NE.0) RETURN
  59.  
  60.         CALL ACTOBJ('MAILLAGE',IPT1,1)
  61.         IF (IERR.NE.0) RETURN
  62.  
  63. C       CALCUL PAR INTEGRALE ELLIPTIQUE (PHR 2002)
  64.         CALL BIOKAM (MCHPO1,IPT1,ENT)
  65.         IF (IERR.NE.0) RETURN
  66.         MCHPOI=ENT
  67. C       ATTRIBUTION D'UNE NATURE DISCRETE AU CHPOINT
  68.         SEGACT MCHPOI*MOD
  69.         JATTRI(1) = 2
  70.  
  71. C       ECRITURE DANS LA PILE ET SORTIE
  72.         CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  73.         CALL ECROBJ('CHPOINT ',MCHPOI)
  74.  
  75.         SEGDES MCOORD
  76.         RETURN
  77.       ENDIF
  78.  
  79.  
  80. C
  81. C     SYNTAXE 1 : AVEC UN MAILLAGE OU UN MODELE
  82. C     QUELQUES INITIALISATIONS
  83.       GY   = 0.D0
  84.       PENT1= 0.D0
  85.       PENT2= 0.D0
  86.       NB   = 1
  87. C     CHOIX DE L'OPTION DE CALCUL (INDUCTION PAR DEFAUT)
  88.       INDU=.TRUE.
  89.       POTE=.FALSE.
  90.       CALL LIRMOT(CHOIX,2,IMC,0)
  91.       IF (IERR.NE.0) RETURN
  92.       IF(IMC.EQ.2) THEN
  93.          POTE=.TRUE.
  94.          INDU=.FALSE.
  95.       ENDIF
  96. C
  97. C     LECTURE D'UN MAILLAGE OU BIEN D'UN MODELE
  98.       CHPO=.FALSE.
  99.       CALL LIROBJ('MAILLAGE',MELEME,0,IRETOU)
  100.       IF (IERR.NE.0) RETURN
  101.  
  102.       IF (IRETOU.EQ.1) THEN
  103.         CALL ACTOBJ('MAILLAGE',MELEME,1)
  104.         IF (IERR.NE.0) RETURN
  105.         CHPO=.TRUE.
  106.  
  107.       ELSE
  108.         CALL LIROBJ('MMODEL',MMODE1,1,IRETOU)
  109.         IF (IERR.NE.0) RETURN
  110.  
  111.         CALL ACTOBJ('MMODEL',MMODE1,1)
  112.         IF (IERR.NE.0) RETURN
  113.  
  114. C       LECTURE FACULTATIVE D'UN LIEU SUPPORT
  115.         CALL LIRMOT(LISUP,5,ISUP,0)
  116.         IF (IERR.NE.0) RETURN
  117.  
  118. C       PAR DEFAUT, LE SUPPORT EST AUX NOEUDS
  119.         IF (ISUP.EQ.0) ISUP=1
  120.         MOT=LISUP(ISUP)
  121.  
  122. C       ON CREE UN MCHAML NUL AUX POINTS SUPPORTS
  123.         CALL ZEROP(MMODE1,MOT,MCHELM)
  124.  
  125. C       RECUPERATION DES CHAMPS DE COORDONNEES DES POINTS SUPPORTS: MCHEL1,2,3
  126.         CALL CHELCO(0,MCHELM,MCHEL3,MCHEL2,MCHEL1)
  127.         IF (IDIM.EQ.2) THEN
  128.           MCHEL1=MCHEL2
  129.           MCHEL2=MCHEL3
  130.         ENDIF
  131.  
  132. C       SUPPRESSION DU MCHAML NUL
  133.         CALL DTCHAM(MCHELM)
  134.       ENDIF
  135. C
  136. C     LECTURE D'UN MOT CLE SUR LA FORME DE L'INDUCTEUR
  137.       CALL LIRMOT(MCLE,4,IMC,1)
  138.       IF (IERR.NE.0) RETURN
  139. C         IMC = 1  ON A LU CERCLE
  140. C         IMC = 2  ON A LU ARC
  141. C         IMC = 3  ON A LU BARRE
  142. C         IMC = 4  ON A LU FIL
  143. C
  144. C
  145. C     SI 'CERC' EN 2D AXI, ON NE LIT QU'UN FLOTTANT
  146.       IF ((IMC.EQ.1).AND.(IFOMOD.EQ.0)) THEN
  147.          CALL LIRREE(Z1,1,IRETOU)
  148.  
  149. C     SINON, LECTURE DE 2 ou 3 POINTS
  150.       ELSE
  151.         CALL LIROBJ('POINT ',IP1,1,IRETOU)
  152.         CALL LIROBJ('POINT ',IP2,1,IRETOU)
  153.         IP3=IP2
  154. C       SI MOT CLEF AUTRE QUE 'FIL', ON LIT UN TROISIEME POINT
  155.         IF(IMC.LT.4) THEN
  156.           CALL LIROBJ('POINT ',IP3,1,IRETOU)
  157. C       CAS DU FIL RECTILIGNE
  158.         ELSE
  159.           GOTO 10
  160.         ENDIF
  161.       ENDIF
  162.       IF (IERR.NE.0) RETURN
  163. C
  164. C     LECTURE DE 4 OU 5 FLOTTANTS SELON LES CAS
  165.       CALL LIRREE(F1,1,IRETOU)
  166.       CALL LIRREE(F2,1,IRETOU)
  167.       F3=0.D0
  168.       IF(IMC.LT.3) CALL LIRREE(F3,1,IRETOU)
  169. C
  170. C     LECTURE DU TYPE DE SECTION
  171.       ISECT=0
  172.       CALL LIRMOT(CHSECT,1,ISECT,0)
  173.       IF(ISECT.EQ.1) THEN
  174.          CALL LIRREE(PENT1,1,IRETOU)
  175.          CALL LIRREE(PENT2,1,IRETOU)
  176.          IF(IERR.NE.0) RETURN
  177.       ELSE
  178.          ISECT=3
  179.       ENDIF
  180.  
  181.  10   CONTINUE
  182. C     LECTURE DE LA DENSITE DE COURANT ET DU LA PERMEABILITE
  183.       CALL LIRREE(DENS,1,IRETOU)
  184.       CALL LIRREE(XIU,1,IRETOU)
  185. C     DANS LE CAS 'CERC' EN 2D AXI, LA DENSITE DE COURANT ORIENTEE
  186. C     SELON UT = UR ^ UZ
  187.       IF ((IMC.EQ.1).AND.(IFOMOD.EQ.0)) THEN
  188.         DENS=-DENS
  189.       ENDIF
  190.  
  191. C     ON VIENT DE LIRE  MU0 DANS L UNITE UTILISATEUR
  192.       RUMKSA=4.D0*XPI*1.D-7
  193.       RAP=XIU/RUMKSA
  194.       IU=1
  195.       IF (IERR.NE.0) RETURN
  196.       ZF1(1)=F1
  197.       ZDENS(1)=DENS
  198.  
  199. C     RECUPERATION DES COORDONNEES DU POINT P1
  200. C     SI 2D AXI, ON PREND P1=(X=0,Y=0,Z=Z1)
  201.       IF (IFOMOD.EQ.0) THEN
  202.         P1(1)=0.D0
  203.         P1(2)=0.D0
  204.         P1(3)=Z1
  205.       ELSE
  206.         IREF=(IDIM+1)*IP1
  207.         P1(1)=XCOOR(IREF-IDIM)
  208.         P1(2)=XCOOR(IREF-IDIM+1)
  209.         P1(3)=0.D0
  210.         IF (IDIM.EQ.3) P1(3)=XCOOR(IREF-IDIM+2)
  211.       ENDIF
  212. C     RECUPERATION DES COORDONNEES DU POINT P2
  213. C     SI 2D AXI, ON PREND P2=(X=F1,Y=0,Z=Z1)
  214.       IF (IFOMOD.EQ.0) THEN
  215.         P2(1)=F1
  216.         P2(2)=0.D0
  217.         P2(3)=Z1
  218. C     SINON, ON RECUPERE LES COORDONNEES DU SECOND POINT LU
  219.       ELSE
  220.         IREF=(IDIM+1)*IP2
  221.         P2(1)=XCOOR(IREF-IDIM)
  222.         P2(2)=XCOOR(IREF-IDIM+1)
  223.         P2(3)=0.D0
  224.         IF (IDIM.EQ.3) P2(3)=XCOOR(IREF-IDIM+2)
  225.       ENDIF
  226. C     RECUPERATION DES COORDONNEES DU POINT P3 (SI MOT CLEF AUTRE QUE 'FIL')
  227.       IF(IMC.LT.4) THEN
  228. C       SI 2D AXI, ON PREND P3=(X=0,Y=F1,Z=Z1)
  229.         IF (IFOMOD.EQ.0) THEN
  230.           P3(1)=0.D0
  231.           P3(2)=F1
  232.           P3(3)=Z1
  233. C       SINON, ON RECUPERE LES COORDONNEES DU TROISIEME POINT LU
  234.         ELSE
  235.           IREF=(IDIM+1)*IP3
  236.           P3(1)=XCOOR(IREF-IDIM)
  237.           P3(2)=XCOOR(IREF-IDIM+1)
  238.           P3(3)=0.D0
  239.           IF (IDIM.EQ.3) P3(3)=XCOOR(IREF-IDIM+2)
  240.         ENDIF
  241.       ENDIF
  242.  
  243. C
  244. C                -----------------------
  245. C                |   LES CALCULS ....  |
  246. C                -----------------------
  247. C
  248. C    ON COMMENCE PAR EXPLORER LE MAILLAGE OU LE MODELE
  249. C    ET INITIALISER LE CHAMP RESULTAT
  250. C
  251. C     CAS DES MAILLAGES (RESULTAT CHPOINT)
  252.       IF (CHPO) THEN
  253.         SEGACT MELEME
  254. C       CONVERTION EN 'POI1' SI NECESSAIRE
  255.         IF (ITYPEL.NE.1.OR.LISOUS(/1).NE.0) CALL CHANGE(MELEME,1)
  256. C       ON INITIALISE LE SEGMENT DE TRAVAIL DU CHPOINT RESULTAT
  257. C       NOMS DES HARMONIQUES ET DES COMPOSANTES
  258. C       POUR L'INSTANT LIMITE AU 3D, 2D PLAN ET 2D AXIS
  259.         NNNOE=NUM(/2)
  260.         NNIN=IDIM
  261.         SEGINI MTRAV
  262.         NHRM=NIFOUR
  263.         IF(NIFOUR.EQ.1) NHRM=IFOUR
  264.         NHAR(1)=NHRM
  265.         NHAR(2)=NHRM
  266.         IF (IDIM.EQ.3) NHAR(3)=NHRM
  267. C       SI 2D AXI, LES COMPOSANTES SERONT SELON R,Z
  268.         IF (IFOMOD.EQ.0) THEN
  269.           IF (INDU) THEN
  270.             INCO(1)='BR  '
  271.             INCO(2)='BZ  '
  272.           ELSE
  273.             INCO(1)='AR  '
  274.             INCO(2)='AZ  '
  275.           ENDIF
  276. C       SINON, LES COMPOSANTES SONT SELON X,Y,Z
  277.         ELSE
  278.           IF (INDU) THEN
  279.             INCO(1)='BX  '
  280.             INCO(2)='BY  '
  281.             INCO(3)='BZ  '
  282.           ELSE
  283.             INCO(1)='AX  '
  284.             INCO(2)='AY  '
  285.             INCO(3)='AZ  '
  286.           ENDIF
  287.         ENDIF
  288.         GOTO (100,100,200,300),IMC
  289. C
  290. C     CAS DU MODELE (RESULTAT MCHAML)
  291.       ELSE
  292. C       PREPARATION DU CHAMP RESULTAT SUR LA BASE DE CELUI DE LA COORDONNEE 1 : MCHEL1
  293.         N1=MCHEL1.INFCHE(/1)
  294.         N3=MCHEL1.INFCHE(/2)
  295.         L1=9
  296.         SEGADJ MCHEL1
  297.         IF(INDU) THEN
  298.           MCHEL1.TITCHE='INDUCTION'
  299.         ELSE
  300.           MCHEL1.TITCHE='POTENTIEL'
  301.         ENDIF
  302. C       BOUCLE SUR LES SOUS ZONES
  303.         NSZ=N1
  304.         DO ISZ=1,NSZ
  305.           MCHAM1=MCHEL1.ICHAML(ISZ)
  306.           MCHAM2=MCHEL2.ICHAML(ISZ)
  307.           IF (IDIM.EQ.3) MCHAM3=MCHEL3.ICHAML(ISZ)
  308. C         AJOUT DE COMPOSANTES DANS MCHAM1
  309.           N2=IDIM
  310.           SEGADJ MCHAM1
  311. C         RENOMAGE DES COMPOSANTES
  312. C         SI 2D AXI, LES COMPOSANTES SERONT SELON R,Z
  313.           IF (IFOMOD.EQ.0) THEN
  314.             IF (INDU) THEN
  315.               MCHAM1.NOMCHE(1)='BR  '
  316.               MCHAM1.NOMCHE(2)='BZ  '
  317.             ELSE
  318.               MCHAM1.NOMCHE(1)='AR  '
  319.               MCHAM1.NOMCHE(2)='AZ  '
  320.             ENDIF
  321. C         SINON, LES COMPOSANTES SONT SELON X,Y,Z
  322.           ELSE
  323.             IF (INDU) THEN
  324.               MCHAM1.NOMCHE(1)='BX  '
  325.               MCHAM1.NOMCHE(2)='BY  '
  326.               MCHAM1.NOMCHE(3)='BZ  '
  327.             ELSE
  328.               MCHAM1.NOMCHE(1)='AX  '
  329.               MCHAM1.NOMCHE(2)='AY  '
  330.               MCHAM1.NOMCHE(3)='AZ  '
  331.             ENDIF
  332.           ENDIF
  333. C         AJOUT DES MELVAL DES AUTRES COORDONNEES
  334.           MCHAM1.TYPCHE(2)=MCHAM2.TYPCHE(1)
  335.           MCHAM1.IELVAL(2)=MCHAM2.IELVAL(1)
  336.           SEGSUP MCHAM2
  337.           IF (IDIM.EQ.3) THEN
  338.             MCHAM1.TYPCHE(3)=MCHAM3.TYPCHE(1)
  339.             MCHAM1.IELVAL(3)=MCHAM3.IELVAL(1)
  340.             SEGSUP MCHAM3
  341.           ENDIF
  342.         ENDDO
  343.         SEGSUP MCHEL2
  344.         IF (IDIM.EQ.3) SEGSUP MCHEL3
  345.         GOTO (100,100,200,300),IMC
  346.       ENDIF
  347.  
  348.  
  349.  100  CONTINUE
  350. C     BOBINE CIRCULAIRE
  351. C     ETABLISSEMENT DU REPERE LOCAL
  352. C     AXE DES Z   (P2 - P1 ) ^ (P3 - P1)
  353.       DO I=1,3
  354.         VX(I)=P2(I)-P1(I)
  355.         VI(I)=P3(I)-P1(I)
  356.       ENDDO
  357.       CALL PROVEC(VX,VI,VZ)
  358.       CALL PROVEC(VZ,VX,VY)
  359.       CALL ROTREP (ROTA,VX,VY,VZ)
  360.  
  361.       IF(IERR.NE.0) THEN
  362.         IF (CHPO) SEGSUP MTRAV
  363.         RETURN
  364.       ENDIF
  365.       IF(A_EGALE_B(F1,XZERO)) THEN
  366.         SEGDES MCOORD
  367.         RETURN
  368.       ENDIF
  369.       ALF=F2/F1
  370.       BET=F3/(2.D0*F1)
  371.       ZALF(1)=ALF
  372.       ZBET(1)=BET
  373. C      IC=3
  374.       RAYO2=EPSIL3
  375.       PROD=0.D0
  376.       DO J=1,3
  377.         PP3(J)= P3(J)-P1(J)
  378.         RAYO2 = RAYO2+VX(J)*VX(J)
  379.         PROD  = PROD+VX(J)*VI(J)
  380.       ENDDO
  381.       TM=ACOS(PROD/RAYO2)
  382.       GOTO  350
  383.  
  384.  
  385.  200  CONTINUE
  386. C   CAS   DES BARRES ON VA TOURNER / OX POUR AMENER OY //  P1P2
  387.       DO I=1,3
  388.         VX(I)=P2(I)-P1(I)
  389.         VI(I)=P3(I)-P1(I)
  390.         GY=GY+(VX(I)*VX(I))
  391.         C(I)= (P2(I)+ P1(I))*0.5D0
  392.       ENDDO
  393.       GY=SQRT( GY)
  394.       CALL PROVEC(VX,VI,VZ)
  395.       CALL PROVEC(VZ,VX,VY)
  396.       CALL ROTREP (ROTA,VX,VY,VZ)
  397.       IF(IERR.NE.0) THEN
  398.         IF (CHPO) SEGSUP MTRAV
  399.         RETURN
  400.       ENDIF
  401.       DO I= 1,3
  402.         VZ(I)=0.D0
  403.         DO J=1,3
  404.           VZ(I)=VZ(I)+ROTA(I,J)*C(J)
  405.         ENDDO
  406.       ENDDO
  407.       GOTO 350
  408.  
  409.  
  410. C     CAS DU FIL
  411.  300  CONTINUE
  412.  350  CONTINUE
  413.       UPSI =1.D-9
  414.  
  415.  
  416. C     INITIALISATION DU SEGMENT SANGLE
  417.       NT4=8000
  418.       SEGINI SANGLE
  419.  
  420.  
  421. C     CAS AVEC MAILLAGE : ON BOUCLE SUR LES NOEUDS
  422.       IF(CHPO) THEN
  423.         DO IPT=1,NNNOE
  424. C         L  EST LE NUMERO DU NOEUD DANS LE TABLEAU DES COORDONNEES
  425. C         RECUPERATION DES COORDONNEES DU NOEUD OU L'ON VA CALCULER LE CHAMP
  426. C         DANS LE TABLEAU PN1
  427.           L=NUM(1,IPT)
  428.           IREF=(IDIM+1)*L
  429.           DO J=1,3
  430.             PN1(J)=XCOOR(IREF-IDIM-1+J)
  431.           ENDDO
  432. C         SI 2D AXI, ON PREND PN1=(X=R,Y=0,Z=Z)
  433.           IF (IFOMOD.EQ.0) THEN
  434.             PN1(3)=PN1(2)
  435.             PN1(2)=0.D0
  436.           ENDIF
  437. C         CALCUL DU CHAMP (B OU A) AU POINT PN1
  438.           CALL BIOSA1(INDU,POTE,IMC,PN1,P1,P2,PP3,ROTA,VI,GY,IU,NB,TM,
  439.      &                  UPSI,PENT1,PENT2,F1,F2,F3,ZF1,ZALF,ZDENS,ZBET,C,
  440.      &                  ISECT,SANGLE,VX,VY,VZ,RESP)
  441.           IF(IERR.NE.0) THEN
  442.             SEGSUP MTRAV
  443.             RETURN
  444.           ENDIF
  445. C         RETOUR DU CHAMP DANS LE REPERE GENERAL
  446.           DO I=1,3
  447.             VY(I)=0.D0
  448.             DO J=1,3
  449.               VY(I)=VY(I)+ROTA(J,I)*RESP(J)*RAP
  450.             ENDDO
  451.           ENDDO
  452. C         SI 2D AXI, ON VA CHERCHER LA COMPOSANTE 3 ET ON LA MET EN POSITION 2
  453. C         POUR AVOIR : BR,BZ (OU AR,AZ)
  454.           IF (IFOMOD.EQ.0) VY(2)=VY(3)
  455. C         REMPLISSAGE DU SEGMENT DE TRAVAIL MTRAV
  456. C         REFERENCE DU NOEUD, VALEUR DU CHAMP ET INDICATEUR DE DEFINITION
  457.           IGEO(IPT)=L
  458.           DO J=1,IDIM
  459.             BB(J,IPT)=VY(J)
  460.             IBIN(J,IPT)=1
  461.           ENDDO
  462.         ENDDO
  463.  
  464.  
  465. C     CAS AVEC MMODELE : ON BOUCLE SUR LES SOUS ZONES/ELEMENTS/POINTS SUPPORTS
  466.       ELSE
  467.         DO ISZ=1,NSZ
  468. C         RECUPERATION DES COORDONNEES DU POINT SUPPORT OU L'ON VA CALCULER LE CHAMP
  469. C         DANS LE TABLEAU PN1
  470.           MCHAM1=MCHEL1.ICHAML(ISZ)
  471.           MELVA1=MCHAM1.IELVAL(1)
  472.           MELVA2=MCHAM1.IELVAL(2)
  473.           IF (IDIM.EQ.3) MELVA3=MCHAM1.IELVAL(3)
  474.           NP=MELVA1.VELCHE(/1)
  475.           NE=MELVA1.VELCHE(/2)
  476.           DO IE=1,NE
  477.             DO K=1,NP
  478.               PN1(1)=MELVA1.VELCHE(K,IE)
  479.               PN1(2)=MELVA2.VELCHE(K,IE)
  480.               PN1(3)=0.D0
  481.               IF (IDIM.EQ.3) PN1(3)=MELVA3.VELCHE(K,IE)
  482. C             SI 2D AXI, ON PREND PN1=(X=R,Y=0,Z=Z)
  483.               IF (IFOMOD.EQ.0) THEN
  484.                 PN1(3)=PN1(2)
  485.                 PN1(2)=0.D0
  486.               ENDIF
  487. C             CALCUL DU CHAMP (B OU A) AU POINT PN1
  488.               CALL BIOSA1(INDU,POTE,IMC,PN1,P1,P2,PP3,ROTA,VI,GY,IU,NB,
  489.      &                    TM,UPSI,PENT1,PENT2,F1,F2,F3,ZF1,ZALF,ZDENS,
  490.      &                    ZBET,C,ISECT,SANGLE,VX,VY,VZ,RESP)
  491.               IF(IERR.NE.0) THEN
  492.                 SEGSUP MCHEL1
  493.                 RETURN
  494.               ENDIF
  495. C             RETOUR DU CHAMP DANS LE REPERE GENERAL
  496.               DO II=1,3
  497.                 VY(II)=0.D0
  498.                 DO JJ=1,3
  499.                   VY(II)=VY(II)+ROTA(JJ,II)*RESP(JJ)*RAP
  500.                 ENDDO
  501.               ENDDO
  502. C             SI 2D AXI, ON VA CHERCHER LA COMPOSANTE 3 ET ON LA MET EN POSITION 2
  503. C             POUR AVOIR : BR,BZ (OU AR,AZ)
  504.               IF (IFOMOD.EQ.0) VY(2)=VY(3)
  505. C             ON REMPLACE LES VALEURS DES COORDONNEES DU POINT PAR CELLE DU CHAMP CALCULE
  506.               MELVA1.VELCHE(K,IE)=VY(1)
  507.               MELVA2.VELCHE(K,IE)=VY(2)
  508.               IF (IDIM.EQ.3) MELVA3.VELCHE(K,IE)=VY(3)
  509.             ENDDO
  510.           ENDDO
  511.         ENDDO
  512.       ENDIF
  513. C     SUPRESSION DU SEGMENT SANGLE
  514.       SEGSUP SANGLE
  515.  
  516.  
  517. C     CREATION DU CHAMP RESULTAT
  518. C     SI CHPOINT, CELUI-CI EST FAIT A PARTIR DU SEGMENT DE TRAVAIL MTRAV
  519.       IF (CHPO) THEN
  520.         CALL CRECHP(MTRAV,MCHPOI)
  521.         SEGSUP MTRAV
  522. C       ATTRIBUTION D'UNE NATURE DISCRETE AU CHPOINT
  523.         SEGACT MCHPOI*MOD
  524.         JATTRI(1)=2
  525. C       ECRITURE DANS LA PILE
  526.         CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  527.         CALL ECROBJ('CHPOINT ',MCHPOI)
  528.  
  529. C     SI MCHAML
  530.       ELSE
  531.         CALL ACTOBJ('MCHAML  ',MCHEL1,1)
  532.         CALL ECROBJ('MCHAML  ',MCHEL1)
  533.       ENDIF
  534.  
  535.       SEGDES MCOORD
  536.  
  537.       END
  538.  
  539.  

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