Télécharger la plaquette Cast3M


fr en

Télécharger elpdy2.eso

Retour à la liste

Numérotation des lignes : 

elpdy2

  1. C ELPDY2    SOURCE    CB215821  25/04/24    21:15:16     12248          
  2.       SUBROUTINE ELPDY2
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-B,D-H,O-Z)
  5.       IMPLICIT COMPLEX*16(C)
  6. ************************************************************************
  7. *
  8. *
  9. *
  10. *       ELFE PLAQUE LAPLACE ...........
  11. *       ---- ------ -------
  12. *
  13. *
  14. ************************************************************************
  15. -INC CCREEL
  16. -INC SMELEME
  17. -INC SMCHPOI
  18. -INC SMCOORD
  19. -INC PPARAM
  20. -INC SMTABLE
  21. -INC SMLREEL
  22. *
  23. *
  24.       POINTEUR MLRE10.MLREEL
  25.       SEGMENT SBORD
  26.       REAL*8 XBORD(15,NS)
  27.       INTEGER IBORD (2 ,NS)
  28.       ENDSEGMENT
  29.       SEGMENT SCOIN
  30.       REAL*8 XCOIN(14,NCOIN)
  31.       INTEGER ICOIN(4 ,NCOIN)
  32.       ENDSEGMENT
  33.       SEGMENT SPOST
  34.       REAL*8 PP0(2,NP0)
  35.       COMPLEX*16  CRP (NP0)
  36.       COMPLEX*16  CPOST(NS4)
  37.       ENDSEGMENT
  38.       SEGMENT SMAT
  39.       COMPLEX*16  CMA1(NS4,NS4)
  40.       COMPLEX*16  CSM (NS4)
  41.       COMPLEX*16  CSOM2 (NS)
  42.       COMPLEX*16  CRE (NS4)
  43.       ENDSEGMENT
  44.       SEGMENT SMAT2
  45.       COMPLEX*16  CMA2(NS4,NS4)
  46.       COMPLEX*16  CSM2(NS4)
  47.       ENDSEGMENT
  48.       SEGMENT SMAI
  49.       INTEGER IAUX(NS4)
  50.       INTEGER IPIVO(NS4)
  51.       INTEGER JPIVO(NS4)
  52.       ENDSEGMENT
  53. *
  54.       CHARACTER * (1) cAR0
  55.       CHARACTER * 1 cAr1
  56.       CHARACTER * 40 CHA1
  57.       CHARACTER * 40 CHA2
  58.       CHARACTER * 40 CHA3
  59.       LOGICAL   LOG0
  60.       LOGICAL   LOG1
  61.       DIMENSION PF0(2)
  62.  
  63.       REE1=0.D0
  64. *
  65. *--1. LECTURE
  66. *
  67. *   ( on fixe ntrap ntrap2,isingu,iregu au lieu de les lire)
  68. *   ( on garde les branchements car les choix de methode ne
  69. *     sont pas definitifs)
  70.       CALL LIROBJ('MAILLAGE',IPT1 ,1,IRET)
  71.       IF (IRET.EQ.0) RETURN
  72.  
  73.       CALL LIRREE(XE1,1,IRET)
  74.       IF (IRET.EQ.0) RETURN
  75.       CALL LIRREE(XH1,1,IRET)
  76.       IF (IRET.EQ.0) RETURN
  77.       CALL LIRREE(XNU1,1,IRET)
  78.       IF (IRET.EQ.0) RETURN
  79.       CALL LIRREE(XRO1,1,IRET)
  80.       IF (IRET.EQ.0) RETURN
  81.       CALL LIROBJ('LISTREEL',MLRE10,1,IRET)
  82.       IF (IRET.EQ.0) RETURN
  83.       NTRap=5
  84.       NTRap2=5
  85. *- COINS
  86.       CALL LIROBJ('MAILLAGE',IPT2 ,0,IRET1)
  87.       IF ( IRET1 .EQ. 1) THEN
  88.          SEGACT  IPT2
  89.          NBELEM = IPT2.NUM(/2)
  90.          NCOIN =     NBELEM
  91.          NC1   =     Ncoin
  92.       else
  93.          NCOIN = 0
  94.          NC1 = 0
  95.          IPT2  = 0
  96.       ENDIF
  97.  
  98. *- C.L.
  99.  
  100.       CALL LIROBJ('MCHAML',MCHELM ,1,IRET)
  101.       IF (IRET.EQ.0) RETURN
  102.  
  103. *- FORCE PONCTUELLE
  104.  
  105.       CALL LIROBJ('POINT',IPF0,1,IRET)
  106.       IF (IRET.EQ.0) RETURN
  107.       XF0 = 1.D0
  108. *- POSTRAITEMENT
  109.  
  110.       CALL LIROBJ('POINT',IPP0,0,IRET1)
  111.       CALL LIROBJ('MAILLAGE',IPT3,0,IRET2)
  112.       IF ( IRET1 .EQ. 1) THEN
  113.          NP0 = 1
  114.       ENDIF
  115.       IF ( IRET2 .EQ. 1) THEN
  116.          SEGACT  IPT3
  117.          NP0 = IPT3.NUM(/2)
  118.       ENDIF
  119.  
  120. *- PARAMETRE LAPLACE
  121.  
  122.       CALL LIRREE(S0,1,IRET)
  123.       IF (IRET.EQ.0) RETURN
  124.       CALL LIROBJ('LISTREEL',MLREE1,1,IRET)
  125.       IF (IRET.EQ.0) RETURN
  126.  
  127. *- PARAMETREs methodes
  128.  
  129.       isingu=1
  130.       iregu=2
  131.  
  132. *--2. DIMENSIONNEMENT
  133. *
  134.       SEGACT  IPT1
  135.       NBELEM = IPT1.NUM(/2)
  136.       NS =     NBELEM
  137.       NS4= 4 * NBELEM
  138.       SEGINI SBORD
  139.       SEGINI SCOIN
  140.       SEGINI SMAT
  141.       SEGINI SMAT2
  142.       SEGINI SMAI
  143.       SEGINI SPOST
  144.       SEGACT MLREE1
  145.       JG = MLREE1.PROG(/1)
  146.       SEGACT MLRE10
  147.       SEGINI SPOST
  148.       IF (NP0 .EQ.1) THEN
  149.          SEGINI MLREE2
  150.          SEGINI MLREE3
  151.       ENDIF
  152.  
  153.       M=0
  154.       SEGINI MTABLE
  155.       iENT0 =0
  156.       REE0 =0d0
  157.       CAR0 =' '
  158.       CAR1 = ' '
  159.       LOG0 =.TRUE.
  160.       LOG1 =.TRUE.
  161.       IPoin0=0
  162. *
  163. *--3. CARACTERISTIQUES GEOMETRIQUES
  164. *
  165.       CI = CMPLX(0.D0,1.D0)
  166.       XD  =  XE1* (XH1**3) / (12 * (1 - XNU1**2))
  167.       XNU = XNU1
  168.  
  169.       CALL ELPGEO (SBORD,SCOIN,SPOST,IPT1,IPT2,IPF0,PF0,IPP0,IPT3)
  170. *
  171. *--4. REMPLISSAGE DES TERMES C.L.
  172. *
  173.       CALL ELPDM2 (SBORD,SMAT,MCHELM)
  174. *
  175. *--5. on commence par un calcul statique bidon indispensable
  176.       ISTAT = 1
  177.       CALL ELPDM1 (XBORD,IBORD,NS
  178.      &     ,XCOIN,ICOIN,NCOIN,NC1
  179.      &     ,CMA1,CSM,CSOM2,NS4
  180.      &     ,XD,XNU,NTRAP,NTRAP2,PF0,XF0,CB,ISTAT
  181.      &     ,isingu,iregu)
  182.       DO  100 K1= 1,NS4
  183.          DO  200 K2= 1,NS4
  184.             CMA2(K1,K2) = CMA1(K1,K2)
  185.  200     CONTINUE
  186.          CSM2(K1)= CSM(K1)
  187.          CRE (K1)= 0D0
  188.  100  CONTINUE
  189. *
  190.          CALL ELPDR1 (CMA2,CSM2 , CRE , NS4  ,IPIVO,JPIVO, IAUX )
  191. *
  192. *--5. BOUCLE SUR LES FREQUENCES DEMANDEES PAR L' UTILISATEUR
  193. *
  194.       DO 1000 I = 1,JG
  195.          xcam = mlre10.prog(i)
  196.          CS1 =  S0 + CI*MLREE1.PROG(I)
  197.          CB =(    (CMPLX(-1)*(xcam*cs1 + XRO1*XH1*CS1*CS1))
  198.      &        /XD )**CMPLX(.25D0)
  199.          IF (MLREE1.PROG(I) .LT . 1E-10) THEN
  200.             ISTAT = 1
  201.          ELSE
  202.             ISTAT = 0
  203.          ENDIF
  204.          CALL ELPDM1 (XBORD,IBORD,NS
  205.      &        ,XCOIN,ICOIN,NCOIN,NC1
  206.      &        ,CMA1,CSM,CSOM2,NS4
  207.      &        ,XD,XNU,NTRAP,NTRAP2,PF0,XF0,CB,ISTAT
  208.      &        ,isingu,iregu)
  209.          DO 1100 K1= 1,NS4
  210.             DO 1200 K2= 1,NS4
  211.                CMA2(K1,K2) = CMA1(K1,K2)
  212.  1200       CONTINUE
  213.             CSM2(K1)= CSM(K1)
  214.             CRE (K1)= 0D0
  215.  1100    CONTINUE
  216. *
  217.             IF ( I .EQ. 1 ) THEN
  218.                CALL ELPDR1 (CMA2,CSM2 , CRE , NS4  ,IPIVO,JPIVO, IAUX )
  219.             ELSE
  220.                CALL ELPDR2 (CMA2,CSM2 , CRE , NS4 ,IPIVO,JPIVO, IAUX )
  221.             ENDIF
  222. C
  223. c  post-traitement
  224. c
  225.          CALL ELPD99 (XBORD,IBORD,NS
  226.      &        ,XCOIN,ICOIN,NCOIN,NC1
  227.      &        ,CRE,CPOST,CRP,NS4
  228.      &        ,XD,XNU,NTRAP,PF0,XF0,PP0,NP0,CB,ISTAT)
  229.  
  230.          IF ( NP0 .EQ. 1) THEN
  231.             CCP  = CRP(1)
  232.             XX = ABS (CCP)
  233.             XR = CCP
  234.             XI = -1*CI*(CCP - XR)
  235.             XT = ATAN2(XI,XR)*180.D0/XPI
  236.             MLREE2.PROG(I) = XX
  237.             MLREE3.PROG(I) = XT
  238.          ELSE
  239.             N = NP0
  240.             NC= 2
  241.             NSOUPO = 1
  242.             SEGINI MPOVAL
  243.             SEGINI MSOUPO
  244.             IPOVAL = MPOVAL
  245.             IGEOC = IPT3
  246.             NOCOMP(1) = 'MODU'
  247.             NOCOMP(2) = 'PHAS'
  248.             NOHARM(1) = 0
  249.             NOHARM(2) = 0
  250.             NAT=1
  251.             SEGINI MCHPOI
  252.             MTYPOI = ' CREE PAR ELFE '
  253.             MOCHDE = ' ELFE '
  254.             IPCHP (1) = MSOUPO
  255. *          MODU  et PHAS sont des chpo diffus
  256.             JATTRI(1) = 1
  257.             IFOPOI = 0
  258.             DO 1110 IP =1,NP0
  259.  
  260.                CCP  = CRP(IP)
  261.                XX = ABS (CCP)
  262.                XR = CCP
  263.                XI = -1*CI*(CCP - XR)
  264.                XT = ATAN2(XI,XR)*180.D0/XPI
  265.                VPOCHA (IP,1)  = XX
  266.                VPOCHA (IP,2)  = XT
  267.  1110       CONTINUE
  268.             CALL ECCTAB(MTABLE,'ENTIER  ',I   ,REE0,CAR0,LOG0,Ipoin0,
  269.      &           'CHPOINT ',iENT0,REE1,CAR1,LOG1,MCHPOI)
  270.          ENDIF
  271.  
  272.  
  273.  1000 CONTINUE
  274. *
  275.       IF ( NP0 .EQ. 1) THEN
  276.          CALL ECCTAB(MTABLE,'ENTIER  ',1   ,REE0,CAR0,LOG0,IPOIN0,
  277.      &        'LISTREEL',ient0,ree1,car1,log1,mlree2)
  278.          CALL ECCTAB(MTABLE,'ENTIER  ',2   ,REE0,CAR0,LOG0,IPOIN0,
  279.      &        'LISTREEL',ient0,ree1,car1,log1,mlree3)
  280.       ENDIF
  281.       CALL ECROBJ('TABLE',MTABLE)
  282. *
  283.       SEGDES MTABLE
  284.       SEGDES MLREE1
  285.  
  286. *
  287.       SEGSUP SBORD
  288.       SEGSUP SCOIN
  289.       SEGSUP SMAT
  290.       SEGSUP SMAT2
  291.       SEGSUP SMAI
  292.       SEGSUP SPOST
  293. *
  294.       RETURN
  295.       END
  296.  
  297.  

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