Télécharger la plaquette Cast3M


fr en

Télécharger d2vfx0.eso

Retour à la liste

Numérotation des lignes : 

d2vfx0

  1. C D2VFX0    SOURCE    BP208322  22/09/21    21:15:01     11463          
  2. C DEVFX0    SOURCE    KK2000    97/09/08    21:16:59     2809
  3.       SUBROUTINE D2VFX0(ITCHAR,KTNUM,KPREF,KTFEX,REPRIS,RIGIDE)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Operateur DYNE : algorithme de Fu - de Vogelaere               *
  9. *     ________________________________________________               *
  10. *                                                                    *
  11. *     Remplissage des tableaux representant les chargements, en      *
  12. *     faisant les interpolations necessaires.                        *
  13. *                                                                    *
  14. *     Parametres:                                                    *
  15. *                                                                    *
  16. * e   ITCHAR  Table representant les chargements                     *
  17. * e   ITINIT  Table representant les conditions initiales            *
  18. * e   KTNUM   Segment contenant les parametres numeriques            *
  19. * e   KPREF   Segment des points de reference                        *
  20. * es  KTFEX   Segment contenant les chargements libres               *
  21. *                                                                    *
  22. *     Auteur, date de creation:                                      *
  23. *     Denis ROBERT-MOUGIN, le 25 mai 1989.                           *
  24. *                                                                    *
  25. *     Parallélisation : BP, 2022-09-19                               *
  26. *                                                                    *
  27. *--------------------------------------------------------------------*
  28. *
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMCHARG
  33. -INC SMCHPOI
  34. -INC SMELEME
  35. -INC SMLREEL
  36. * Declarations pour le travail en parallele
  37. -INC CCASSIS
  38.       COMMON/dyneco/IPARAL
  39. c     SPARAL : pour la parallelisation
  40. C     + NBTHRD  : nombre de threads demandes
  41. C     + ...     : pointeur vers segments utiles
  42.       SEGMENT SPARAL
  43.         INTEGER NBTHRD
  44.         INTEGER IERROR(NBTHR)
  45.         INTEGER KMTRAV
  46.         INTEGER KMTFEX
  47.         INTEGER NDIM1,NDIM2,NDIM3
  48.       ENDSEGMENT
  49.  
  50.       EXTERNAL MATMUi
  51.       LOGICAL  BTHRD
  52.  
  53. *     IL S'AGIT DE REMPLIR :
  54. *     FEXA(.,.,1)  valeur au pas  m
  55. *     FEXA(.,.,2)  valeur au pas  m - 1
  56. *
  57.       SEGMENT,MTNUM
  58.          REAL*8 XDT(NPC1),XTEMPS(NPC1)
  59.       ENDSEGMENT
  60.       SEGMENT,MTFEX
  61.          REAL*8  FEXA(NPFEXA,NPC1,2)
  62.          REAL*8  FEXPSM(NPLB,NPC1,2,IDIMB)
  63.          REAL*8  FTEXB(NPLB,NPC1,2,IDIM)
  64. *         INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB)
  65.       ENDSEGMENT
  66.       SEGMENT,MTRAV
  67.          REAL*8 FTCHG(NCHAR,NPC1)
  68.          REAL*8 XFORCA(NPREF,NCHAR)
  69.       ENDSEGMENT
  70.       SEGMENT,MPREF
  71.          INTEGER IPOREF(NPREF)
  72.       ENDSEGMENT
  73.       LOGICAL L0,L1,REPRIS,RIGIDE
  74.       CHARACTER*8 TYPRET,CHARRE
  75. *
  76.       MTNUM = KTNUM
  77.       MTFEX = KTFEX
  78.       MPREF = KPREF
  79.       NPREF = IPOREF(/1)
  80.       NPC1 = XDT(/1)
  81.  
  82.  
  83. **********************************************************************************
  84. *
  85. *     CAS CHARGEMENTS EN BASE_A
  86. *
  87. **********************************************************************************
  88.  
  89.       TYPRET = ' '
  90.       CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_A',L0,IP0,
  91.      &                  TYPRET,I1,X1,CHARRE,L1,ICHAR1)
  92.       IF (ICHAR1.EQ.0 .OR. TYPRET.NE.'CHARGEME') GOTO 9000
  93.  
  94.       MCHARG = ICHAR1
  95.       SEGACT,MCHARG
  96.       NCHAR = KCHARG(/1)
  97. *     creation du tableau de travail receptacle des chargements interpoles      
  98.       SEGINI,MTRAV
  99.       KTRAV = MTRAV
  100.  
  101. **********************************************************************************
  102. *     Remplissage de MTRAV :
  103. *     Boucle sur les chargements elementaires
  104. **********************************************************************************
  105.  
  106.       DO 10 ICHAR=1,NCHAR
  107.  
  108.             ICHARG = KCHARG(ICHAR)
  109.             SEGACT,ICHARG
  110.             IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(ICHAR).NE.'STAT'
  111.      &      .OR.CHALIE(ICHAR).NE.'LIE ') THEN
  112.                SEGDES ICHARG
  113.                SEGDES MCHARG
  114.                CALL ERREUR(696)
  115.                RETURN
  116.             ENDIF
  117.             MLR1 = ICHPO2
  118.             MLR2 = ICHPO3
  119. *           Interpolation temporelle des chargements vers MTRAV.FTCHG
  120. *           FTCHG(ichar,n+1) = Fext^ichar(t_n)  avec n={0...nombre de pas}
  121.             CALL D2VINT(MLR1,MLR2,KTNUM,KTRAV,ICHAR)
  122.             MTRAV = KTRAV
  123.  
  124.  10   CONTINUE
  125.  
  126.       DO 11 ICHAR=1,NCHAR
  127.  
  128.             ICHARG = KCHARG(ICHAR)   
  129. *           copie du chpoint vers MTRAV.XFORCA
  130.             MCHPOI = ICHPO1
  131.             SEGACT,MCHPOI
  132.             NSOUPO = IPCHP(/1)
  133.             DO 20 I=1,NSOUPO
  134.                MSOUPO = IPCHP(I)
  135.                SEGACT,MSOUPO
  136.                MELEME = IGEOC
  137.                SEGACT,MELEME
  138.                NC = NOCOMP(/2)
  139.                MPOVAL = IPOVAL
  140.                SEGACT,MPOVAL
  141.                N = VPOCHA(/1)
  142.                DO 30 J=1,N
  143.                   DO 35 K=1,NC
  144.                      KNOE = NUM(1,J)
  145.                      CALL PLACE2(IPOREF,NPREF,IPOS,KNOE)
  146.                      IF (IPOS.EQ.0) GOTO 35
  147.                      XFORCA(IPOS,ICHAR) = VPOCHA(J,K)
  148.  35               CONTINUE
  149.  30            CONTINUE
  150.                SEGDES,MPOVAL,MELEME,MSOUPO
  151.  20         CONTINUE
  152.             SEGDES,MCHPOI,ICHARG
  153.  
  154.  11   CONTINUE
  155.       SEGDES,MCHARG
  156.  
  157.  
  158. **********************************************************************************
  159. *     Remplissage de FEXA :
  160. *     Triple boucle sur les modes x chargements x pas de temps
  161. **********************************************************************************
  162. *
  163. *     rappel : FTCHG(ichar,n+1) = Fext^ichar(t_n)  avec n={0...nombre de pas}
  164. *                      pas n
  165. *              -----+--------+----->t
  166. *                 t_n-1     t_n
  167. *
  168. *     Ainsi, dans d2vini : Fext_i(t_0) = FEXA(I,n=1   ,2 <=> debut de pas) 
  169. *            dans d2vfxa : Fext_i(t_0) = FEXA(I,n=NPAS,1 <=> fin de pas  ) 
  170. *
  171. *     rem : ce double tableau (initialement pour devogelaere) est ici bien inutile
  172. *
  173.  
  174. *     Version parallélisée (par mode = NPREF)
  175. *     --------------------
  176.  
  177. C     FAUT-IL PASSER EN // ? (valeur mise au pif)
  178.       if ((NPREF*NCHAR*NPC1).le.1.E4) then
  179.         NBTHR = 1
  180.         BTHRD=.false.
  181.       else
  182.         NBTHR = MIN(NBTHRS,NPREF)
  183.         BTHRD = .TRUE.
  184.         CALL THREADII
  185.       endif
  186. *     CREATION ET REMPLISSAGE DU SEGMENT POUR LA //iSATION
  187.       SEGINI,SPARAL
  188.       SPARAL.NBTHRD = NBTHR
  189.       SPARAL.KMTRAV = MTRAV
  190.       SPARAL.KMTFEX = MTFEX
  191.       SPARAL.NDIM1  = NPREF
  192.       SPARAL.NDIM2  = NCHAR
  193.       SPARAL.NDIM3  = NPC1
  194.       IPARAL=SPARAL  
  195.  
  196. *    -CALCUL PARALLELE-
  197.       IF (BTHRD) THEN
  198.          DO ith=2,NBTHR
  199.            CALL THREADID(ith,MATMUi)
  200.          ENDDO
  201.          CALL MATMUi(1)  
  202. C        Attente de la fin de tous les threads en cours de travail
  203.          DO ith=2,NBTHR
  204.            CALL THREADIF(ith)
  205.          ENDDO  
  206. C        On libere les Threads
  207.          CALL THREADIS  
  208. C        Verification de l'erreur (Apres liberation des THREADS)
  209.          DO ith=1,NBTHR
  210.            IRETOU=SPARAL.IERROR(ith)
  211.            IF (IRETOU .GT. 0) THEN
  212.              CALL ERREUR(IRETOU)
  213.              RETURN
  214.            ENDIF
  215.          ENDDO
  216.  
  217. *    -CALCUL SEQUENTIEL-
  218.       ELSE
  219. C        Appel a la SUBROUTINE qui fait le travail
  220.          IPOINT=IPARAL
  221.          CALL MATMU0(1,IPOINT)
  222. C        Verification de l'erreur
  223.          IRETOU=SPARAL.IERROR(1)
  224.          IF (IRETOU .GT. 0) THEN
  225.            CALL ERREUR(IRETOU)
  226.            RETURN
  227.          ENDIF
  228.  
  229.       ENDIF
  230.  
  231.       SEGSUP,MTRAV,SPARAL
  232.       RETURN
  233.  
  234.  
  235.  
  236.  9000 CONTINUE  
  237. **********************************************************************************
  238. *
  239. *     CAS CHARGEMENTS EN BASE_B
  240. *
  241. **********************************************************************************
  242.  
  243.       TYPRET = ' '
  244.       CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_B',L0,IP0,
  245.      &                  TYPRET,I1,X1,CHARRE,L1,ICHAR2)
  246.       IF ((ICHAR2.EQ.0).OR.(.NOT.RIGIDE)) THEN
  247.          CALL ERREUR(486)
  248.          RETURN
  249.       ENDIF
  250.  
  251.       END
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  

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