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

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