Télécharger la plaquette Cast3M


fr en

Télécharger biosa1.eso

Retour à la liste

Numérotation des lignes : 

biosa1

  1. C BIOSA1    SOURCE    CB215821  25/03/25    21:15:03     12217          
  2.       SUBROUTINE BIOSA1(INDU,POTE,IMC,PN1,P1,P2,PP3,ROTA,VI,GY,IU,NB,TM,
  3.      &                  UPSI,PENT1,PENT2,F1,F2,F3,ZF1,ZALF,ZDENS,ZBET,C,
  4.      &                  ISECT,SANGLE,VX,VY,VZ,RESP)
  5.  
  6. C     Routine appelee par BIOSAV
  7. C     Calcul du champ d'induction ou du potentiel vecteur en un point
  8. C     cible PN1
  9.  
  10.  
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8(A-H,O-Z)
  13.  
  14. C     SANGLE est juste tansmis dans cette SUBROUTINE
  15.       INTEGER SANGLE
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC CCREEL
  20.  
  21.       LOGICAL INDU,POTE
  22.       DIMENSION C(3),PN1(3),RESP(3)
  23.       DIMENSION VX(3),VZ(3),VY(3),VI(3),PP3(3)
  24.       DIMENSION ZF1(1),ZALF(1),ZDENS(1),ZBET(1)
  25.       DIMENSION P1(3),P2(3),P3(3),ROTA(3,3)
  26.       DATA EPSIL3/1.D-12/,EPSIL2/1.D-8/
  27.  
  28.  
  29.       ALF=ZALF(1)
  30.       BET=ZBET(1)
  31.       DENS=ZDENS(1)
  32.       XUN   =1.D0
  33.       XDEUX =2.D0
  34.       XDEUX =2.D0
  35.       XDEMI =0.5D0
  36.       XPREC =1.D-6
  37.  
  38. C     EMBRANCHEMENT VERS LA BONNE PARTIE DE LA SUBROUTINE
  39. C     SELON LE TYPE D'INDUCTEUR (CERCLE, ARC, BARRE, FIL)
  40.       GOTO (100,100,200,300),IMC
  41.  
  42.  
  43.  
  44.  
  45. C     CAS DES CERCLES ET DES ARC
  46.  100  CONTINUE
  47. C     MESURE DU POINT DANS LE REPERE LOCAL
  48.       DO J=1,3
  49.         PN1(J)=PN1(J)-P1(J)
  50.       ENDDO
  51.       DO I= 1,3
  52.         VZ(I)=XZERO
  53.         VY(I)=XZERO
  54.         DO J= 1,3
  55.           VY(I)=VY(I)+ROTA(I,J)*PN1(J)
  56.           VZ(I)=VZ(I)+ROTA(I,J)*PP3(J)
  57.         ENDDO
  58.       ENDDO
  59. C     ON  CHANGE DE RERERENTIEL
  60. C     MESURE DANS LE REPERE LOCAL DES POINTS DE CALCUL DE HS
  61.       ZP=VY(3)
  62.       RP=SQRT(VY(1)**2+VY(2)**2)
  63.       IF(A_EGALE_B (RP,XZERO)) THEN
  64.         TMIN=XZERO
  65.         COST=XUN
  66.         SINT=XZERO
  67.         RP=EPSIL2
  68.       ELSE
  69.         TMIN=ACOS(VY(1)/(RP+EPSIL3))
  70.         COST=COS(TMIN)
  71.         SINT=VY(2)/(RP+EPSIL3)
  72.       ENDIF
  73.       DO J= 1,3
  74.         C(J)=XZERO
  75.       ENDDO
  76.  
  77.  
  78. C
  79. C     CAS DU FIL CIRCULAIRE
  80.       IF(BET.EQ.XZERO .AND. ALF.EQ.XUN) THEN
  81.         RAYON=F1
  82.         COUR=DENS
  83. C       ON CONSTRUIT LE REPERE LOCAL
  84.         SIGT=XUN
  85.         IF(ABS(SINT).GT.XPREC) SIGT=SIGN(XUN,-SINT)
  86.         TMIN=SIGT*(TMIN-XPI)+XPI
  87.         IF(IMC.EQ.1) TM=XDEUX*XPI
  88.         TMAX=TMIN+TM
  89.         CALL TEGRAL(SANGLE)
  90.         IF(INDU) THEN
  91.           CALL BFILCI(SANGLE,COUR,RAYON,TMIN,TMAX,RP,ZP,BX,BY,BZ)
  92.         ENDIF
  93.         IF(POTE) THEN
  94.           CALL AFILCI(SANGLE,COUR,RAYON,TMIN,TMAX,RP,ZP,BX,BY,BZ)
  95.         ENDIF
  96.         RESP(1)=BX*COST-BY*SINT
  97.         RESP(2)=BX*SINT+BY*COST
  98.         RESP(3)=BZ
  99.  
  100. C     CAS DE LA PLAQUE CIRCULAIRE
  101.       ELSE IF(BET.EQ.XZERO.AND.ISECT.EQ.3) THEN
  102.         RINT=F1
  103.         REXT=F2
  104.         DR=REXT-RINT
  105.         COUR=DENS*DR
  106. C       ON CONSTRUIT LE REPERE LOCAL
  107.         SIGT=XUN
  108.         IF(ABS(SINT).GT.XPREC) SIGT=SIGN(XUN,-SINT)
  109.         TMIN=SIGT*(TMIN-XPI)+XPI
  110.         IF(IMC.EQ.1) TM=XDEUX*XPI
  111.         TMAX=TMIN+TM
  112.         CALL TEGRAL(SANGLE)
  113.         IF(INDU) THEN
  114.           CALL BPLQCI(SANGLE,COUR,RINT,REXT,TMIN,TMAX,RP,ZP,BX,BY,BZ)
  115.         ENDIF
  116.         IF(POTE) THEN
  117.           CALL APLQCI(SANGLE,COUR,RINT,REXT,TMIN,TMAX,RP,ZP,BX,BY,BZ)
  118.         ENDIF
  119.         RESP(1)=BX*COST-BY*SINT
  120.         RESP(2)=BX*SINT+BY*COST
  121.         RESP(3)=BZ
  122.  
  123. C     CAS DU CYLINDRE
  124.       ELSEIF(ALF.EQ.1D0) THEN
  125.         RAYON=F1
  126.         H=F3
  127.         COUR=DENS*H
  128. C       ON CONSTRUIT LE REPERE LOCAL
  129.         SIGT=XUN
  130.         IF(ABS(SINT).GT.XPREC) SIGT=SIGN(XUN,-SINT)
  131.         TMIN=SIGT*(TMIN-XPI)+XPI
  132.         IF(IMC.EQ.1) TM=XDEUX*XPI
  133.         TMAX=TMIN+TM
  134.         CALL TEGRAL(SANGLE)
  135.         IF(INDU) THEN
  136.           CALL BCYLCI(SANGLE,COUR,RAYON,H,TMIN,TMAX,RP,ZP,BX,BY,BZ)
  137.         ENDIF
  138.         IF(POTE) THEN
  139.           CALL ACYLCI(SANGLE,COUR,RAYON,H,TMIN,TMAX,RP,ZP,BX,BY,BZ)
  140.         ENDIF
  141.         RESP(1)=BX*COST-BY*SINT
  142.         RESP(2)=BX*SINT+BY*COST
  143.         RESP(3)=BZ
  144.  
  145. C     AUTRES CAS
  146.       ELSE
  147.         IF (IMC.EQ.1.AND.ISECT.EQ.3) THEN
  148.           IF(INDU) THEN
  149.            CALL CHAMBO(IU,IC,NB,C(3),ZF1,ZALF,ZBET,ZDENS,ZP,RP,BZ,BR,BP)
  150.             IF (RP.LE.UPSI) THEN
  151.               RESP(1)=XZERO
  152.               RESP(2)=XZERO
  153.             ELSE
  154.               RESP(1)=BR*VY(1)/RP
  155.               RESP(2)=BR*VY(2)/RP
  156.             ENDIF
  157.             RESP(3)=BZ
  158.             GOTO 999
  159.           ENDIF
  160.           IF(POTE) THEN
  161.             RINT=F1
  162.             REXT=F2
  163.             HCEN=F3
  164.             WIDTH=F2-F1
  165.             AIRE=F3*WIDTH
  166.             COUR=DENS*AIRE
  167.             DELTA=XZERO
  168. C           ON CONSTRUIT LE REPERE LOCAL
  169.             SIGT=XUN
  170.             IF(ABS(SINT).GT.1.E-8) SIGT=SIGN(XUN,-SINT)
  171.             TMIN=SIGT*(TMIN-XPI)+XPI
  172.             TM=XDEUX*XPI
  173.             TMAX=TMIN+TM
  174.             PENT1=XZERO
  175.             PENT2=XZERO
  176.             CALL TEGRAL(SANGLE)
  177.             CALL AARCTR(SANGLE,COUR,HCEN,HCEN,RINT,REXT,
  178.      &                  PENT1,PENT2,TMIN,TMAX,RP,ZP,BX,BY,BZ)
  179.             RESP(1)=BX*COST-BY*SINT
  180.             RESP(2)=BX*SINT+BY*COST
  181.             RESP(3)=BZ
  182.             GOTO 999
  183.           ENDIF
  184.         ENDIF
  185.  
  186. C       CAS DES SECTIONS RECTANGULAIRES
  187.         IF(ISECT.EQ.3) THEN
  188. C       ON CALCULE POUR UN ARC ---> ANGLES
  189.           A1=XZERO
  190.           IF (ABS(VZ(1)).LT.UPSI) THEN
  191.             A2=XPI/XDEUX
  192.           ELSE
  193.             AA=VZ(2)/VZ(1)
  194.             A2=ATAN (AA)
  195.             IF (A2.LT.XZERO) A2=XPI+A2
  196.           ENDIF
  197.           IF(INDU) THEN
  198.             CALL CHAMAR(IU,IC,C,A1,A2,F1,ALF,BET,DENS,
  199.      &                  VY(1),VY(2),VY(3),BX,BY,BZ)
  200.             RESP(1)=BX
  201.             RESP(2)=BY
  202.             RESP(3)=BZ
  203.           ENDIF
  204.           IF(POTE) THEN
  205.             RINT=F1
  206.             REXT=F2
  207.             HCEN=F3
  208.             WIDTH=F2-F1
  209.             AIRE=F3*WIDTH
  210.             COUR=DENS*AIRE
  211.             PENT1=XZERO
  212.             PENT2=XZERO
  213. C           ON CONSTRUIT LE REPERE LOCAL
  214.             SIGT=XUN
  215.             IF(ABS(SINT).GT.XPREC) SIGT=SIGN(XUN,-SINT)
  216.             TMIN=SIGT*(TMIN-XPI)+XPI
  217.             TMAX=TMIN+TM
  218.             CALL TEGRAL(SANGLE)
  219.             CALL AARCTR(SANGLE,COUR,HCEN,HCEN,RINT,REXT,
  220.      &                  PENT1,PENT2,TMIN,TMAX,RP,ZP,BX,BY,BZ)
  221.             RESP(1)=BX*COST-BY*SINT
  222.             RESP(2)=BX*SINT+BY*COST
  223.             RESP(3)=BZ
  224.           ENDIF
  225.  
  226. C       CAS DES SECTIONS TRAPEZOIDALES
  227.         ELSEIF(ISECT.EQ.1) THEN
  228.           RINT=F1
  229.           REXT=F2
  230.           HCEN=F3
  231.           WIDTH=F2-F1
  232.           AIRE=F3*WIDTH
  233.           COUR=DENS*AIRE
  234.           DELTA=XDEMI*WIDTH*(PENT2-PENT1)
  235.           HINT=HCEN-DELTA
  236.           HEXT=HCEN+DELTA
  237.  
  238. C         ON CONSTRUIT LE REPERE LOCAL
  239.           SIGT=XUN
  240.           IF(ABS(SINT).GT.1.E-06) SIGT=SIGN(XUN,-SINT)
  241.           TMIN=SIGT*(TMIN-XPI)+XPI
  242.           IF(IMC.EQ.1) TM=XDEUX*XPI
  243.           TMAX=TMIN+TM
  244.           CALL TEGRAL(SANGLE)
  245.           IF(HCEN.EQ.XZERO) THEN
  246. C         CAS DU TRONC DE CONE
  247.             TETA=ATAN(PENT1)
  248.             COUR=DENS*WIDTH/COS(TETA)
  249.             IF(INDU) THEN
  250.               CALL BTRCON(SANGLE,COUR,RINT,REXT,PENT1,TMIN,TMAX,
  251.      &                    RP,ZP,BX,BY,BZ)
  252.             ENDIF
  253.             IF(POTE) THEN
  254.               CALL ATRCON(SANGLE,COUR,RINT,REXT,PENT1,TMIN,TMAX,
  255.      &                    RP,ZP,BX,BY,BZ)
  256.             ENDIF
  257. C         AUTRES CAS
  258.           ELSE
  259.             IF(INDU) THEN
  260.               CALL ARCTRA(SANGLE,COUR,HINT,HEXT,RINT,REXT,
  261.      &                    PENT1,PENT2,TMIN,TMAX,RP,ZP,BX,BY,BZ)
  262.             ENDIF
  263.             IF(POTE) THEN
  264.               CALL AARCTR(SANGLE,COUR,HINT,HEXT,RINT,REXT,
  265.      &                    PENT1,PENT2,TMIN,TMAX,RP,ZP,BX,BY,BZ)
  266.             ENDIF
  267.           ENDIF
  268.           RESP(1)=BX*COST-BY*SINT
  269.           RESP(2)=BX*SINT+BY*COST
  270.           RESP(3)=BZ
  271.         ENDIF
  272.       ENDIF
  273.       IF(IERR.NE.0) RETURN
  274.       GOTO 999
  275.  
  276.  
  277.  
  278. C     CAS DES BARRES
  279.  200  CONTINUE
  280. C     ON  CHANGE DE RERERENTIEL
  281.       DO I= 1,3
  282.          VY(I)=XZERO
  283.          DO J= 1,3
  284.             VY(I)=VY(I)+ROTA(I,J)*PN1(J)
  285.          ENDDO
  286.       ENDDO
  287.  
  288. C     MESURE DANS LE REPERE LOCAL DES POINTS DE CALCUL DE HS
  289. C     CAS DES SECTIONS RETANGULAIRES
  290.       IF(ISECT.EQ.3) THEN
  291.         IF(F2.EQ.XZERO) THEN
  292. C         CAS DE LA PLAQUE RECTANGULAIRE
  293.           DO I=1,3
  294.             VY(I)=XZERO
  295.             DO J=1,3
  296.               VY(I)=VY(I)+ROTA(I,J)*(PN1(J)-P1(J))
  297.             ENDDO
  298.           ENDDO
  299.           DY=F1
  300.           REXT=XDEMI*DY
  301.           RINT=-REXT
  302.           COUR=DENS*DY
  303.           YMIN=-VY(1)
  304.           YMAX=YMIN+GY
  305.           XP=-VY(2)
  306.           ZP=VY(3)
  307.           IF(INDU) THEN
  308.             CALL BPLQDR(COUR,RINT,REXT,YMIN,YMAX,XP,ZP,BXP,BYP,BZP)
  309.           ENDIF
  310.           IF(POTE) THEN
  311.             CALL APLQDR(COUR,RINT,REXT,YMIN,YMAX,XP,ZP,BXP,BYP,BZP)
  312.           ENDIF
  313.           RESP(1)=BYP
  314.           RESP(2)=-BXP
  315.           RESP(3)=BZP
  316.         ELSE
  317.           IF(INDU) THEN
  318.             CALL CHABAR(IU,VZ,GY,F1,F2,DENS,VY(1),VY(2),VY(3),
  319.      &                  BXP,BYP,BZP)
  320.             RESP(1)=BXP
  321.             RESP(2)=BYP
  322.             RESP(3)=BZP
  323.           ENDIF
  324.           IF(POTE) THEN
  325.             DO I=1,3
  326.               VY(I)=XZERO
  327.               DO J=1,3
  328.                 VY(I)=VY(I)+ROTA(I,J)*(PN1(J)-P1(J))
  329.               ENDDO
  330.             ENDDO
  331.             DY=F1
  332.             DZ=F2
  333.             REXT=XDEMI*DY
  334.             RINT=-REXT
  335.             AIRE=DY*DZ
  336.             COUR=DENS*AIRE
  337.             PENT1=XZERO
  338.             PENT2=XZERO
  339.             YMIN=-VY(1)
  340.             YMAX=YMIN+GY
  341.             XP=-VY(2)
  342.             ZP=VY(3)
  343.             CALL ASEGTR(COUR,DZ,DZ,RINT,REXT,PENT1,PENT2,
  344.      &                  YMIN,YMAX,XP,ZP,BXP,BYP,BZP)
  345.             RESP(1)=BYP
  346.             RESP(2)=-BXP
  347.             RESP(3)=BZP
  348.           ENDIF
  349.         ENDIF
  350. C     CAS DES SECTIONS TRAPEZOIDALES
  351.       ELSEIF(ISECT.EQ.1) THEN
  352.         DO I=1,3
  353.           VY(I)=XZERO
  354.           DO J=1,3
  355.             VY(I)=VY(I)+ROTA(I,J)*(PN1(J)-P1(J))
  356.           ENDDO
  357.         ENDDO
  358.         DY=F1
  359.         DZ=F2
  360.         REXT=XDEMI*DY
  361.         RINT=-REXT
  362.         AIRE=DY*DZ
  363.         COUR=DENS*AIRE
  364.         DELTA=XDEMI*DY*(PENT2-PENT1)
  365.         HINT=DZ-DELTA
  366.         HEXT=DZ+DELTA
  367.         YMIN=-VY(1)
  368.         YMAX=YMIN+GY
  369.         XP=-VY(2)
  370.         ZP=VY(3)
  371.         IF(INDU) THEN
  372.           CALL SEGTRA(COUR,HINT,HEXT,RINT,REXT,PENT1,PENT2,
  373.      &                YMIN,YMAX,XP,ZP,BXP,BYP,BZP)
  374.         ENDIF
  375.         IF(POTE) THEN
  376.           CALL ASEGTR(COUR,HINT,HEXT,RINT,REXT,PENT1,PENT2,
  377.      &                YMIN,YMAX,XP,ZP,BXP,BYP,BZP)
  378.         ENDIF
  379.         RESP(1)=BYP
  380.         RESP(2)=-BXP
  381.         RESP(3)=BZP
  382.       ENDIF
  383.       GOTO 999
  384.  
  385.  
  386.  
  387. C     CAS DU FIL
  388.  300  CONTINUE
  389.       GY=XZERO
  390.       DO I=1,3
  391.         VY(I)=P2(I)-P1(I)
  392.         VI(I)=PN1(I)-P1(I)
  393.         GY=GY+(VY(I)*VY(I))
  394.       ENDDO
  395.       GY=SQRT(GY)
  396.       CALL PROVEC(VI,VY,VZ)
  397.       CALL PROVEC(VY,VZ,VX)
  398.       CALL ROTREP (ROTA,VX,VY,VZ)
  399.       IF(IERR.NE.0) RETURN
  400.       XP=XZERO
  401.       YMIN=XZERO
  402.       DO J= 1,3
  403.         XP=XP+ROTA(1,J)*VI(J)
  404.         YMIN=YMIN-ROTA(2,J)*VI(J)
  405.       ENDDO
  406.       YMAX=YMIN+GY
  407.       COUR=DENS
  408.       IF(INDU) THEN
  409.         CALL BFILDR(COUR,YMIN,YMAX,XP,BZP)
  410.         RESP(1)=XZERO
  411.         RESP(2)=XZERO
  412.         RESP(3)=BZP
  413.       ENDIF
  414.       IF(POTE) THEN
  415.         CALL AFILDR(COUR,YMIN,YMAX,XP,AYP)
  416.         RESP(1)=XZERO
  417.         RESP(2)=AYP
  418.         RESP(3)=XZERO
  419.       ENDIF
  420.  
  421.  999  CONTINUE
  422.       RETURN
  423.       END
  424.  
  425.  

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