Télécharger la plaquette Cast3M


fr en

Télécharger elfgr2.eso

Retour à la liste

Numérotation des lignes : 

elfgr2

  1. C ELFGR2    SOURCE    CB215821  17/11/30    21:16:01     9639           
  2.       SUBROUTINE ELFGR2(KGREEN,DELTAT,M,NPAS,MAXBLO,KNREFE,KANBN,KDNCN)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C  =====================================================================
  7. C  APPELE PAR ELFE
  8. C  INITIALISATION DES BLOCS ANBN ET DNCN
  9. C  REMPLISSAGE DES ANBN AVEC LES FONCTIONS DE GREEN ( KGREEN )
  10. C
  11. C  CREATION    : 22/09/87
  12. C  PROGRAMMEUR : GUILBAUD
  13. C  =====================================================================
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC CCREEL
  18. -INC SMEVOLL
  19. -INC SMLREEL
  20. C
  21.       SEGMENT MANBN
  22.         POINTEUR KAB(NSGA).ANBN
  23.       ENDSEGMENT
  24. C
  25. C   NSGA  : NOMBRE DE BLOCS ANBN
  26. C
  27.       SEGMENT ANBN
  28.         REAL*8 AB(NTANBN,LANBN)
  29.       ENDSEGMENT
  30. C
  31. C   AB(I,K) : TERME I DE LA MATRICE A OU B D'UN ELEMENT AU TEMPS K
  32. C   NTANBN : NOMBRE DE TERMES DES MATRICES A ET B DE TOUS LES ELEMENTS
  33. C   LANBN  : NOMBRE DE PAS DE TEMPS STOCKES DANS UN BLOC ANBN
  34. C
  35.       SEGMENT MDNCN
  36.         POINTEUR KDC(NSGD).DNCN
  37.       ENDSEGMENT
  38. C
  39. C   NSGD  : NOMBRE DE BLOCS DNCN
  40. C
  41.       SEGMENT DNCN
  42.         REAL*8 DC(NIDNCN,LDNCN)
  43.       ENDSEGMENT
  44. C
  45. C   DC(I,K) : DDL I AU TEMPS (K-1)*DELTAT
  46. C   NIDNCN : NOMBRE TOTAL D'INCONNUES
  47. C   LDNCN  : 1 + NOMBRE DE PAS DE TEMPS STOCKES DANS UN BLOC DNCN
  48. C
  49.       SEGMENT MNREFE
  50.         INTEGER NREFE(8,NSTR)
  51.         INTEGER NTANBN
  52.         INTEGER NIDNCN
  53.         INTEGER NTVN
  54.         POINTEUR NREPA.MPASS
  55.         POINTEUR NRECA.MCARA
  56.         POINTEUR NRENO.MNORM
  57.         POINTEUR NRECPR.ICPR
  58.         POINTEUR NREMEL.MELEME
  59.         POINTEUR NREDEN.MDEN
  60.       ENDSEGMENT
  61. C
  62. C   NSTR       : NOMBRE D'ELEMENTS
  63. C   NREFE(1,I) : MELEME
  64. C   NREFE(2,I) : MSOSTU
  65. C   NREFE(3,I) : TYPE DE L'ELEMENT
  66. C   NREFE(4,I) : NOMBRE DE POINTS DU MELEME
  67. C   NREFE(5,I) : NOMBRE DE DDL PAR POINT
  68. C   NREFE(6,I)=IVN :LE 1ER DDL DE L'ELEMENT EST LE IVN+1 IEME DE VN
  69. C   NREFE(7,I)=IAN :LE 1ER TERME DE LA MATRICE A EST LE IAN IEME DE ANBN
  70. C   NREFE(8,I)=1 :LE IEME ELEMENT EST RIGIDE (OU PARTIELLEMENT) SINON 0
  71. C   NTANBN : NOMBRE DE TERMES DES MATRICES A ET B POUR TOUS LES ELEMENTS
  72. C   NIDNCN : NOMBRE TOTAL D'INCONNUES DE DNCN
  73. C   NTVN   : LONGUEUR DU TABLEAU VN
  74. C
  75.       SEGMENT MCARA
  76.         REAL*8 CARA(LCAR*NSTR)
  77.       ENDSEGMENT
  78. C
  79. C   LCAR    : NOMBRE DE CARACTERISTIQUES DE L'ELEMENT
  80. C
  81.       SEGMENT MDEN
  82.         INTEGER IDEN(INS)
  83.       ENDSEGMENT
  84. C
  85. C   IL Y A INS STRUCTURES AYANT DES CARACTERISTIQUES DIFFERENTES
  86. C   IDEN  CONTIENT LEUR NUMERO D'ORDRE DANS MNREFE
  87. C
  88.       SEGMENT ITRAV(INS)
  89.       CHARACTER *72 ITEX
  90.       LOGICAL TRACTI,TORSIO
  91. C
  92.       EPS=1.D-3
  93.       IF (IIMPI.EQ.1) THEN
  94.          WRITE(IOIMP,*) ' DEBUT DE ELFGR2 '
  95.       END IF
  96.       MNREFE=KNREFE
  97.       MDEN=NREDEN
  98.       NSTR=NREFE(/2)
  99.       MCARA=NRECA
  100.       LCAR=CARA(/1)/NSTR
  101.       IF(M.EQ.0) M=NPAS
  102.       TMAX=M*DELTAT
  103. C
  104. C  RECHERCHE DES FONCTIONS DE GREEN
  105. C
  106.       MEVOLL=KGREEN
  107.       SEGACT MEVOLL
  108.       NBEL=IEVOLL(/1)
  109.       IF(MOD(NBEL,28).NE.0) THEN
  110. C *** IL MANQUE DES FONCTIONS DE GREEN
  111.         CALL ERREUR(388)
  112.         SEGDES MEVOLL
  113.         RETURN
  114.       ENDIF
  116.       INS=IDEN(/1)
  117.       SEGINI ITRAV
  118.       DO 20 NB=1,NBEL
  119.       KEVOLL=IEVOLL((NB-1)*28+1)
  120.       SEGACT KEVOLL
  121.       MLREEL=IPROGX
  122.       SEGACT MLREEL
  123.       DT=PROG(2)-PROG(1)
  124.       IL=PROG(/1)
  125.       TT=PROG(IL)
  126.       SEGDES MLREEL
  127.       DT2=DT*0.999999999
  128.       IF (DELTAT.LT.DT2 .OR. (INT(DELTAT/DT)*DT).LT.DT2) THEN
  129.          CALL ERREUR(389)
  130.          SEGDES KEVOLL
  131.          SEGDES MEVOLL
  132.          RETURN
  133.       END IF
  134.       IF(TMAX .GT. TT) THEN
  135. C *** LA DUREE DU CALCUL EST TROP GRANDE POUR LES FONCTIONS DE GREEN
  136.         CALL ERREUR(390)
  137.         SEGDES KEVOLL
  138.         SEGDES MEVOLL
  139.         RETURN
  140.       ENDIF
  141.       ITEX=KEVTEX
  142.       READ (ITEX(6:17),FMT='(1PE12.5)')  DLL
  143.       READ (ITEX(24:35),FMT='(1PE12.5)') CTC
  144.       READ (ITEX(43:54),FMT='(1PE12.5)') RTC
  145.       SEGDES KEVOLL
  146.       KEVOLL=IEVOLL((NB-1)*28+3)
  147.       SEGACT KEVOLL
  148.       ITEX=KEVTEX
  149.       READ (ITEX(24:35),FMT='(1PE12.5)') CTO
  150.       READ (ITEX(43:54),FMT='(1PE12.5)') RTO
  151.       SEGDES KEVOLL
  152.       KEVOLL=IEVOLL((NB-1)*28+5)
  153.       SEGACT KEVOLL
  154.       ITEX=KEVTEX
  155.       READ (ITEX(43:54),FMT='(1PE12.5)') RFZ
  156.       SEGDES KEVOLL
  157.       KEVOLL=IEVOLL((NB-1)*28+10)
  158.       SEGACT KEVOLL
  159.       ITEX=KEVTEX
  160.       READ (ITEX(43:54),FMT='(1PE12.5)') RFY
  161.       SEGDES KEVOLL
  162. C
  163. C        BOUCLE SUR LES ELEMENTS------------------------------
  164. C
  165.       DO 10 IN=1,INS
  166.       IF(ITRAV(IN).EQ.0) THEN
  167.         NS=IDEN(IN)
  168.         NCA=LCAR*(NS-1)
  169.         DIF=ABS(1.D0-DLL/CARA(NCA+1))
  170.         IF(DIF.GT.EPS) GOTO 10
  171. C       DIF=ABS(1.D0-CTC/CARA(NCA+6))
  172. C       IF(DIF.GT.EPS) GOTO 10
  173.         DIF=ABS(1.D0-RTC/CARA(NCA+2))
  174.         IF(DIF.GT.EPS) GOTO 10
  175. C       DIF=ABS(1.D0-CTO/CARA(NCA+7))
  176. C       IF(DIF.GT.EPS) GOTO 10
  177.         DIF=ABS(1.D0-RTO/CARA(NCA+3))
  178.         IF(DIF.GT.EPS) GOTO 10
  179.         DIF=ABS(1.D0-RFY/CARA(NCA+4))
  180.         IF(DIF.GT.EPS) GOTO 10
  181.         DIF=ABS(1.D0-RFZ/CARA(NCA+5))
  182.         IF(DIF.GT.EPS) GOTO 10
  183.         ITRAV(IN)=NB
  184.         GOTO 20
  185.       ENDIF
  186.    10 CONTINUE
  187.    20 CONTINUE
  188.       DO 30 IN=1,INS
  189.       IF(ITRAV(IN).EQ.0) THEN
  190. C *** IL MANQUE LES FONCTIONS DE GREEN DE LA SOUS-STRUCTURE
  191.         NS=IDEN(IN)
  192.         INTERR(1)=NREFE(2,NS)
  193.         CALL ERREUR(391)
  194.       ENDIF
  195.    30 CONTINUE
  196.       IF(IERR.EQ.2) THEN
  197.         SEGSUP ITRAV
  198.         SEGDES MEVOLL
  199.         RETURN
  200.       ENDIF
  201. C
  202. C       CREATION DES BLOCS ANBN
  203. C
  204.       IF(NTANBN.GT.MAXBLO) THEN
  205. C *** TAILLE DU CALCUL TROP IMPORTANTE
  206.         CALL ERREUR(382)
  207.         RETURN
  208.       ENDIF
  209.       LANBN=MAXBLO/NTANBN
  210.       LANBND=LANBN
  211.       NSGA=(M-1)/LANBN+1
  212.       SEGINI MANBN
  213.       KANBN=MANBN
  214.       DO 40 K=1,NSGA
  215.       IF(K.EQ.NSGA) LANBN=M-(NSGA-1)*LANBN
  216.       SEGINI ANBN
  217.       SEGDES ANBN
  218.       KAB(K)=ANBN
  219.   40  CONTINUE
  220.       LANBN=LANBND
  221. C
  222. C       CREATION DES BLOCS DNCN
  223. C
  224.       IF(NIDNCN.GT.MAXBLO) THEN
  225. C *** TAILLE DU CALCUL TROP IMPORTANTE
  226.         CALL ERREUR(382)
  227.         RETURN
  228.       ENDIF
  229.       LDNCN=MAXBLO/NIDNCN
  230.       MPAS=NPAS
  231.       IF(M.NE.NPAS) THEN
  232. C  TRONCATURE DU PRODUIT DE CONVOLUTION ( MEMOIRE GLISSANT PAR BLOC )
  233.         MMPAS=M+LDNCN
  234.         IF(NPAS.GT.MMPAS) MPAS=MMPAS
  235.       ENDIF
  236.       NSGD=MPAS/LDNCN+1
  237.       SEGINI MDNCN
  238.       KDNCN=MDNCN
  239.       DO 50 K=1,NSGD
  240.       SEGINI DNCN
  241.       CALL ZERO(DC,NIDNCN,LDNCN)
  242.       SEGDES DNCN
  243.       KDC(K)=DNCN
  244.    50 CONTINUE
  245.       IF (IIMPI .EQ. 1801) THEN
  246.          WRITE(IOIMP,*) 'NIDNC= ',NIDNCN
  247.          WRITE(IOIMP,*) 'MAXBLO= ',MAXBLO
  248.          WRITE(IOIMP,*) 'NB DE BLOCS ',NSGD
  249.       END IF
  250. C
  251. C        BOUCLE SUR LES BLOCS
  252. C
  253.       LDEC=0
  254.       DO 100 K=1,NSGA
  255.       ANBN=KAB(K)
  256.       SEGACT ANBN
  257.       LANBN=AB(/2)
  258. C
  259. C--------BOUCLE SUR LES ELEMENTS------------------------------
  260. C
  261.       DO 90 IN=1,INS
  262.          NB=ITRAV(IN)
  263.          NS=IDEN(IN)
  264.          NRG=NREFE(7,NS)-1
  265. *
  266.          DO 80 J=1,28
  267.             KEVOLL=IEVOLL((NB-1)*28+J)
  268.             SEGACT KEVOLL
  269.             MLREEL=IPROGX
  270.             SEGACT MLREEL
  271.             DT=PROG(2)-PROG(1)
  272.             DIF=ABS(1.D0-DT/DELTAT)
  273.             SEGDES MLREEL
  274.             MLREEL=IPROGY
  275.             SEGACT MLREEL
  276.             IF (DIF.LT.EPS) THEN
  277.                DO 60 L=1,LANBN
  278.                   AB(NRG+J,L)=PROG(L+LDEC)
  279. 60             CONTINUE
  280.             ELSE
  281.                DO 70 L=1,LANBN
  282.                   T=DELTAT*DBLE(L+LDEC)
  283.                   N=INT(T/DT)
  284.                   ALPHA=(T-DBLE(N)*DT)/DT
  285.                   N1=N+1
  286.                   N2=N+2
  287.                   AB(NRG+J,L)=(PROG(N2)-PROG(N1))*ALPHA+PROG(N1)
  288. 70             CONTINUE
  289.             END IF
  290.             SEGDES MLREEL
  291.             SEGDES KEVOLL
  292. 80       CONTINUE
  293. *
  294.          IF(IIMPI.EQ.1801)THEN
  295.            WRITE(IOIMP,*) ' STRUCTURE ',NS
  296.            WRITE(IOIMP,1000) K
  297.  1000      FORMAT(1X,//I5,'IEME  BLOC DES TERMES DES MATRICES ANBN'/)
  298.            DO 120 J=1,28
  299.            WRITE(IOIMP,1001) (J,AB(NRG+J,LL2),LL2=1,LANBN)
  300.  1001      FORMAT(1X,5(I5,1X,1PE12.5))
  301.  120       CONTINUE
  302.          ENDIF
  303.    90 CONTINUE
  304.       SEGDES ANBN
  305.       LDEC=LDEC+LANBN
  306.   100 CONTINUE
  307. C
  308. C     BOUCLE SUR LES ELEMENTS POUR DETERMINER CEUX QUI SONT RIGIDES
  309. C
  310.       DO 110 NS=1,NSTR
  311.       NCA=LCAR*(NS-1)
  312.       DLL=CARA(NCA+1)
  313.       CTC=CARA(NCA+6)
  314.       WRITE(IOIMP,*)' CTC= ',CTC
  315.       DTL=DLL/CTC
  316.       IF(DELTAT.GT.DTL) THEN
  317.         NREFE(8,NS)=1
  318.         GOTO 110
  319.       ENDIF
  320.       CTO=CARA(NCA+7)
  321.       DTL=DLL/CTO
  322.       IF(DELTAT.GT.DTL) THEN
  323.         NREFE(8,NS)=1
  324.         GOTO 110
  325.       ENDIF
  326.       RFY=CARA(NCA+4)
  327.       DTL=DLL*DLL/(3.D0*CTC*RFY*XPI)
  328.       IF(DELTAT.GT.DTL) THEN
  329.         NREFE(8,NS)=1
  330.         GOTO 110
  331.       ENDIF
  332.       RFZ=CARA(NCA+5)
  333.       DTL=DLL*DLL/(3.D0*CTC*RFZ*XPI)
  334.       IF(DELTAT.GT.DTL) THEN
  335.         NREFE(8,NS)=1
  336.         GOTO 110
  337.       ENDIF
  338.   110 CONTINUE
  339.       WRITE(IOIMP,*) ' NREFE ',(NREFE(8,NS),NS=1,NSTR)
  340.       SEGSUP ITRAV
  341.       SEGDES MEVOLL
  342.       IF (IIMPI.EQ.1) THEN
  343.          WRITE(IOIMP,*)' FIN DE ELFGR2 '
  344.       END IF
  345.       RETURN
  346.       END
  347.  
  348.  
  349.  
  350.  
  351.  

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