Télécharger la plaquette Cast3M


fr en

Télécharger yclpls.eso

Retour à la liste

Numérotation des lignes : 

yclpls

  1. C YCLPLS    SOURCE    CB215821  26/08/24    21:18:58     12622          
  2.       SUBROUTINE YCLPLS(HR,RPG,LE,NEL,K0,NPTI,NPTS,NX,IES,NP,IAXI,
  3.      & IPADI,IPADS,
  4.      & COEFF,IK1,
  5.      & TN,G,
  6.      & VOLU,COTE,NELZ,DME,DIAM,
  7.      & DT,DTT2,NUEL,DIAEL)
  8. C
  9. C VERSION VECTORISEE (CF XCVTIT POUR PLUS DE DETAILS)
  10. C
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8 (A-H,O-Z)
  13. C NOMBRE MAXI DE POINTS PAR ELEMENT : NPX
  14.       PARAMETER(NPX=9)
  15. C LONGUEUR DES REGISTRES VECTORIELS DE LA MACHINE CIBLE
  16.       PARAMETER(LRV=64)
  17. C***********************************************************************
  18. C
  19. C  CE SP DISCRETISE LE LAPLACIEN D UNE VARIABLE SCALAIRE
  20. C
  21. C    EN 1D SUR L ELEMENT SEG2
  22. C    EN 2D SUR L ELEMENT QUA4       PLAN OU AXI
  23. C    EN 3D SUR L ELEMENT CUB8 PRI6 et TET4
  24. C  LES OPERATEURS SONT SOUS INTEGRES
  25. C
  26. C  COEFF(SCAL DOMA)  LE COEFFICIENT DU LAPLACIEN  ( NU )
  27. C       (SCAL ELEM)
  28. C
  29. C     NUELD(NELZ): NUMERO DE L'ELEMENT NK DE LA ZONE DANS LE DOMAINE
  30. C     (NELZ      : NOMBRE D'ELEMENTS DE LA ZONE)
  31. C     ROC(NELD)  : ROC PAR ELEMENT DONNE SUR TOUT LE DOMAINE
  32. C
  33. C
  34. C***********************************************************************
  35. -INC CCVQUA4
  36. -INC CCREEL
  37. C
  38.       DIMENSION TN(NPTI,NX),GG(8)
  39.       DIMENSION COEFF(*)
  40.       DIMENSION COTE(NELZ,IES),DME(*),VOLU(*),DIAM(*)
  41.  
  42.       DIMENSION IPADI(*),LE(NP,1),IPADS(*)
  43.       DIMENSION HR(NEL,NP,IES),RPG(1)
  44.  
  45.       REAL*8    G(NPTS,NX)
  46.       REAL*8    ROC(1)
  47.       DIMENSION NUELD(1)
  48.       DIMENSION QGGT(8,8),Q1(8,8),Q2(8,8),Q3(8,8)
  49. C
  50. C
  51.  
  52. C* -TABLEAUX ADDITIONNELS POUR LA VECTORISATION   **********************
  53.       DIMENSION AIRE(LRV),ALF (LRV),COEF(LRV),CLSR(LRV),GINC(LRV)
  54.       DIMENSION AL  (LRV),AH  (LRV),AP  (LRV),CFM (LRV),XMA (LRV)
  55.       DIMENSION XMB(LRV),XMD(LRV),XMH(LRV),XMI(LRV),AHL(LRV)
  56.       DIMENSION ALH(LRV),DPR(LRV),TETA(LRV,NPX,3),F(LRV,NPX),BF(LRV,NPX)
  57. C
  58. C --- TABLEAU POUR L'OPTION RAPIDE ---
  59.       DIMENSION ALP(LRV)
  60. C***
  61.       SAVE IPAS,QGGT,Q1,Q2,Q3
  62.       DATA IPAS/0/
  63.  
  64. C
  65. C           INITIALISATIONS DIVERSES
  66. C
  67. C      WRITE(6,*)' ROC=',(ROC(MM),MM=1,NEL)
  68. C      WRITE(6,*)' NUELD=',(NUELD(MM),MM=1,NEL)
  69.  
  70.       NK=K0
  71.       CALL INITD(BF,64,0.D0)
  72.  
  73.       IF(IES.EQ.2)GO TO 20
  74.       IF(IES.EQ.3)GO TO 30
  75. C**********
  76. C                                          *   1D*
  77. C**********
  78. C
  79. C
  80. C K EST LE NUMERO DE L'ELEMENT
  81. C KP PERMET DE SE SITUER A L'INTERIEUR DES TABLEAUX DE LRV ELEMENTS
  82.       NPACK=INT(NEL/FLOAT(LRV))+1
  83.       KPACKD=1
  84.       KPACKF=NPACK
  85. C
  86. C*** BOUCLE SUR LES ELEMENTS ***
  87. C
  88.       DO 70001 KPACK=KPACKD,KPACKF
  89. C     DO 40 K=1,NEL
  90. C
  91. C POUR CHAQUE PAQUET DE LRV ELEMENTS
  92.       KDEB=1+(KPACK-1)*LRV
  93.       KFIN=MIN(NEL,KDEB+LRV-1)
  94.       DO 70002 K=KDEB,KFIN
  95.       KP=K-KDEB+1
  96.       NK=K+K0
  97.       K1=1+(1-IK1)*(NK-1)
  98.       COEF(KP)=COEFF(K1)
  99.       CLSR(KP)=COEFF(K1)
  100.       AIRE(KP)=VOLU(NK)
  101.       XMA(KP)=AIRE(KP)
  102. 70002 CONTINUE
  103.       DO 90008 I=1,NP
  104.       DO 90007 N=1,NX
  105.       DO 4 K=KDEB,KFIN
  106.       KP=K-KDEB+1
  107.       NF=IPADI(LE(I,K))
  108.       TETA(KP,I,N)=TN(NF,N)
  109.     4 CONTINUE
  110. 90007 CONTINUE
  111. 90008 CONTINUE
  112. C
  113. C
  114. C
  115.       DO 70003 K=KDEB,KFIN
  116.       NK=K+K0
  117.       KP=K-KDEB+1
  118.       DT0=DT
  119.       DT2=0.5*XMA(KP)*XMA(KP)/CLSR(KP)
  120.       IF(DT2.LT.DT)DT=DT2
  121.       IF(DT.EQ.DT0)GO TO 152
  122.       DTT2=DT2
  123.       DIAEL=XMA(KP)
  124.       NUEL=NK
  125.  152  CONTINUE
  126. 70003 CONTINUE
  127. C
  128. C
  129.       N=1
  130. C --- CALCUL DE L'INCREMENT GINC ---------------------------
  131.       DO 70104 K=KDEB,KFIN
  132.       KP=K-KDEB+1
  133.       GINC(KP)=COEF(KP)*(TETA(KP,1,N)-TETA(KP,2,N))/AIRE(KP)
  134. 70104 CONTINUE
  135. C --- ACCUMULATION DANS LE TABLEAU G -----------------------
  136.       DO 70004 K=KDEB,KFIN
  137.       KP=K-KDEB+1
  138.       NF=IPADS(LE(1,K))
  139.       G(NF,N)=G(NF,N) -  GINC(KP)
  140.       NF=IPADS(LE(2,K))
  141.       G(NF,N)=G(NF,N) +  GINC(KP)
  142. 70004 CONTINUE
  143. 70001 CONTINUE
  144.   40  CONTINUE
  145.       IPAS=1
  146.       RETURN
  147. C                           ***********
  148. C                           *   2D    *
  149. C                           ***********
  150.   20  CONTINUE
  151. C
  152.  
  153. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  154.  
  155. C                           DIFFERENCES TRIANGLE / QUADRANGLE
  156.       QUA4=0.D0
  157.       IF(NP.EQ.4)QUA4=1.D0
  158.  
  159. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  160.  
  161.  
  162. C
  163. C K EST LE NUMERO DE L'ELEMENT
  164. C KP PERMET DE SE SITUER A L'INTERIEUR DES TABLEAUX DE LRV ELEMENTS
  165.       NPACK=INT(NEL/FLOAT(LRV))+1
  166.       KPACKD=1
  167.       KPACKF=NPACK
  168. C
  169. C*** BOUCLE SUR LES ELEMENTS ***
  170. C
  171.       DO 80001 KPACK=KPACKD,KPACKF
  172. C
  173. C POUR CHAQUE PAQUET DE LRV ELEMENTS
  174.       KDEB=1+(KPACK-1)*LRV
  175.       KFIN=MIN(NEL,KDEB+LRV-1)
  176.       DO 80002 K=KDEB,KFIN
  177.       KP=K-KDEB+1
  178.       NK=K+K0
  179.       K1=1+(1-IK1)*(NK-1)
  180.       XMI(KP)=DIAM(NK)
  181.       XMA(KP)=DME(NK)
  182.       COEF(KP)=COEFF(K1)
  183.       CLSR(KP)=COEFF(K1)
  184.       AIRE(KP)=VOLU(NK)
  185. CC
  186.       AL(KP)=COTE(NK,1)
  187.       AH(KP)=COTE(NK,2)
  188.       XMB(KP)=(AL(KP)+AH(KP))/2.
  189.       XMD(KP)=((AL(KP)*AH(KP))**2)/(AL(KP)**2+AH(KP)**2)
  190.       AHL(KP)=AH(KP)/AL(KP)
  191.       ALH(KP)=AL(KP)/AH(KP)
  192.       DPR(KP)=1.D0
  193.       IF(IAXI.NE.0)DPR(KP)=2.D0*XPI*RPG(K)
  194. 80002 CONTINUE
  195. CC
  196. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  197. C
  198.       DO 90010 I=1,NP
  199.       DO 90009 N=1,NX
  200.       DO 5 K=KDEB,KFIN
  201.       KP=K-KDEB+1
  202.       NF=IPADI(LE(I,K))
  203.       TETA(KP,I,N)=TN(NF,N)
  204.     5 CONTINUE
  205. 90009 CONTINUE
  206. 90010 CONTINUE
  207. C
  208. C
  209. C
  210.       DO 80004 K=KDEB,KFIN
  211.       KP=K-KDEB+1
  212.       NK=K+K0
  213.       DT0=DT
  214.       DT2=0.5*XMD(KP)/CLSR(KP)
  215.       IF(DT2.LT.DT)DT=DT2
  216.       IF(DT.EQ.DT0)GO TO 252
  217.       DTT2=DT2
  218.       DIAEL=XMB(KP)
  219.       NUEL=NK
  220.  252  CONTINUE
  221. 80004 CONTINUE
  222. C
  223. C --- VERSION RAPIDE -----------------------
  224.       CF12=1.D0/12.D0
  225.       DO 80011 K=KDEB,KFIN
  226.       KP=K-KDEB+1
  227.       ALP(KP)=CF12*(AHL(KP)+ALH(KP))*DPR(KP)*QUA4
  228. 80011 CONTINUE
  229. C ------------------------------------------
  230. C
  231.       DO 90011 N=1,NX
  232.       DO 90012 I= 1,NP
  233.       DO 80010 K=KDEB,KFIN
  234.       KP=K-KDEB+1
  235.       BF(KP,I)=0.D0
  236. 80010 CONTINUE
  237. 90012 CONTINUE
  238.  
  239.       DO 1 I=1,NP
  240.       DO 90013 J= 1,NP
  241.       DO 3 K=KDEB,KFIN
  242.       KP=K-KDEB+1
  243.       BF(KP,I)=BF(KP,I)+TETA(KP,J,N)*
  244.      &       ((HR(K,I,1)*HR(K,J,1)+HR(K,I,2)*HR(K,J,2))*AIRE(KP)
  245.      &        +ALP(KP)*VGGT(J,I))*COEF(KP)
  246.    3  CONTINUE
  247. 90013 CONTINUE
  248.  
  249. C --- ACCUMULATION DANS LE TABLEAU G ------------------------------
  250.       DO 80006 K=KDEB,KFIN
  251.       KP=K-KDEB+1
  252.       NF=IPADS(LE(I,K))
  253.       G(NF,N)=G(NF,N)-BF(KP,I)
  254. 80006 CONTINUE
  255.     1 CONTINUE
  256. 90011 CONTINUE
  257. 80001 CONTINUE
  258.   50  CONTINUE
  259.  
  260. C     WRITE(6,*)' SUB XCLPLS G(1,='
  261. C     WRITE(6,1002) (G(MM,1),MM=1,NPTS)
  262. C     WRITE(6,*)' SUB XCLPLS G(2,='
  263. C     WRITE(6,1002) (G(MM,2),MM=1,NPTS)
  264. C     WRITE(6,*)' FIN **** '
  265.  
  266.       IPAS=1
  267.       RETURN
  268.  30   CONTINUE
  269. C                           ***********
  270. C                           *   3D    *
  271. C                           ***********
  272.  
  273.       IF(IPAS.EQ.0)CALL CALHRH(QGGT,Q1,Q2,Q3,IES)
  274.       CUB8=0.D0
  275.       IF(NP.EQ.8)CUB8=1.D0
  276.  
  277.  1003 FORMAT('   XCVTI ',10I10)
  278. C
  279. C K EST LE NUMERO DE L'ELEMENT
  280. C KP PERMET DE SE SITUER A L'INTERIEUR DES TABLEAUX DE LRV ELEMENTS
  281.       NPACK=INT(NEL/FLOAT(LRV))+1
  282.       KPACKD=1
  283.       KPACKF=NPACK
  284. C
  285. C*** BOUCLE SUR LES ELEMENTS ***
  286. C
  287.       DO 90001 KPACK=KPACKD,KPACKF
  288. C     DO 60 K=1,NEL
  289. C
  290. C POUR CHAQUE PAQUET DE LRV ELEMENTS
  291.       KDEB=1+(KPACK-1)*LRV
  292.       KFIN=MIN(NEL,KDEB+LRV-1)
  293.       DO 90002 K=KDEB,KFIN
  294.       KP=K-KDEB+1
  295.       NK=K+K0
  296.       K1=1+(1-IK1)*(NK-1)
  297.       AL(KP)=COTE(NK,1)
  298.       AH(KP)=COTE(NK,2)
  299.       AP(KP)=COTE(NK,3)
  300.       CFM(KP)=AL(KP)*AH(KP)/AP(KP)+AL(KP)*AP(KP)/AH(KP)+
  301.      &        AP(KP)*AH(KP)/AL(KP)
  302.       XMI(KP)=DIAM(NK)
  303.       XMA(KP)=DME(NK)
  304.       COEF(KP)=COEFF(K1)
  305. C      CLSR(KP)=COEFF(K1)/ROC(NUELD(NK))
  306.       CLSR(KP)=COEFF(K1)
  307.       AIRE(KP)=VOLU(NK)
  308.       XMB(KP)=(XMA(KP)+XMI(KP))*0.5
  309.       XMD(KP)=((XMA(KP)*XMI(KP))**2)/(2.*XMA(KP)**2+XMI(KP)**2)
  310.       XMH(KP)=AIRE(KP)**0.33
  311. 90002 CONTINUE
  312. C
  313.       DO 90015 I=1,NP
  314.       DO 90014 N=1,NX
  315.       DO 15 K=KDEB,KFIN
  316.       KP=K-KDEB+1
  317.       NF=IPADI(LE(I,K))
  318.       TETA(KP,I,N)=TN(NF,N)
  319.    15 CONTINUE
  320. 90014 CONTINUE
  321. 90015 CONTINUE
  322. C     WRITE(6,*)' K ** ',K,' TETA ','    VOLU=',AIRE,'  COEF=',COEF
  323. C    &,'  XMH=',XMH
  324. C     WRITE(6,1002)(TETA(MM,1),MM=1,8)
  325. C
  326. C
  327.       DO 90003 K=KDEB,KFIN
  328.       KP=K-KDEB+1
  329.       NK=K+K0
  330.       DT0=DT
  331.       DT2=0.5*XMD(KP)/CLSR(KP)
  332.       IF(DT2.LT.DT)DT=DT2
  333.       IF(DT.EQ.DT0)GO TO 353
  334.       DTT2=DT2
  335.       DIAEL=XMB(KP)
  336.       NUEL=NK
  337.  353  CONTINUE
  338. 90003 CONTINUE
  339. C
  340.       DO 90016 N=1,NX
  341.       DO 90017 I=1,NP
  342.       DO 90004 K=KDEB,KFIN
  343.       KP=K-KDEB+1
  344.       BF(KP,I)=0.
  345. 90004 CONTINUE
  346. 90017 CONTINUE
  347.       DO 11 I=1,NP
  348.       DO 90018 J=1,NP
  349.       DO 13 K=KDEB,KFIN
  350.       KP=K-KDEB+1
  351.       GEO1=CFM(KP)*QGGT(J,I)*CUB8
  352.       BF(KP,I)=BF(KP,I)+TETA(KP,J,N)*
  353.      &((HR(K,I,1)*HR(K,J,1)+HR(K,I,2)*HR(K,J,2)+HR(K,I,3)*HR(K,J,3))
  354.      & *AIRE(KP)+XMH(KP)*GEO1)*COEF(KP)
  355.   13  CONTINUE
  356. 90018 CONTINUE
  357.       DO 90006 K=KDEB,KFIN
  358.       KP=K-KDEB+1
  359.       NF=IPADS(LE(I,K))
  360.       G(NF,N)=G(NF,N)-BF(KP,I)
  361. 90006 CONTINUE
  362.    11 CONTINUE
  363. 90016 CONTINUE
  364. 90001 CONTINUE
  365. C     WRITE(6,*)' GG(I)='
  366. C     WRITE(6,1002)GG
  367.    60 CONTINUE
  368. C     CALL ARRET(0)
  369.       IPAS=1
  370.       RETURN
  371.  1001 FORMAT('  XCVTI',I10,6E12.5)
  372.  1002 FORMAT(10(1X,1PE11.4))
  373.       END
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.  
  382.  
  383.  
  384.  

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