Télécharger la plaquette Cast3M


fr en

Télécharger hbmalo.eso

Retour à la liste

Numérotation des lignes : 

hbmalo

  1. C HBMALO    SOURCE    OF166741  26/05/11    21:15:07     12538          
  2.  
  3. *--------------------------------------------------------------------*
  4. *                                                                    *
  5. *     Operateur DYNC : continuation par longueur d'arc               *
  6. *     ________________________________________________               *
  7. *                                                                    *
  8. *     Dimensionnement des tableaux de travail ( allocation de la     *
  9. *     memoire ).                                                     *
  10. *                                                                    *
  11. *     Parametres:                                                    *
  12. *                                                                    *
  13. * e   ITBAS   Table representant une base modale                     *
  14. * e   ITKM    Table contenant les matrices XK et XM                  *
  15. * e   ITA     Table contenant la matrice XASM                        *
  16. * e   ITLIA   Table rassemblant la description des liaisons          *
  17. * e   ITCHAR  Table contenant les chargements                        *
  18. * e   ITINIT  Table donnant les conditions initiales                 *
  19. * e   NINS    On veut une sortie tous les NINS pas de calcul         *
  20. * e   ITREDU  Table contenant les noms d'inconnues de la base B      *
  21. *             auxquelles on se restreint                             *
  22. * e   IPARNUM Table des les parametres numeriques (continuation)     *
  23. * e   KPREF   Segment des points de reference                        *
  24. * e   NHBM    Nombre d'harmoniques de l'approximation                *
  25. * s   MTQ     Segment contenant les coefficients de Fourier          *
  26. * s   MTKAM   Segment contenant les vecteurs XK, XASM et XM          *
  27. * s   MTPHI   Segment contenant les deformees modales                *
  28. * s   MTLIAA  Segment descriptif des liaisons en base A              *
  29. * s   MTLIAB  Segment descriptif des liaisons en base B              *
  30. * s   MTFEX   Segment contenant les chargements libres               *
  31. * s   MTPAS   Segment des variables au cours d'un pas de temps       *
  32. * s   PARNUM  Segment des parametres numeriques (continuation)       *
  33. * s   MTRES   Segment de sauvegarde des resultats                    *
  34. * s   MTNUM   Segment contenant les parametres temporels             *
  35. * s   REPRIS  Vrai si reprise de calcul, faux sinon                  *
  36. * s   ICHAIN  Segment MLENTI (ACTIF) contenant les adresses des      *
  37. *             chaines dans la pile des mots de CCNOYAU               *
  38. * s   KOCLFA  Segment contenant les tableaux locaux de la subroutine *
  39. *             DEVLFA                                                 *
  40. * s   KOCLB1  Segment contenant les tableaux locaux de la subroutine *
  41. *             DEVLB1                                                 *
  42. *                                                                    *
  43. *     Auteur, date de creation:                                      *
  44. *                                                                    *
  45. *     Roberto ALCORTA, le 18 juin 2019.                              *
  46. *--------------------------------------------------------------------*
  47.  
  48.       SUBROUTINE HBMALO(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NINS,ITREDU,
  49.      &                  IPARNUM,KPREF,KTQ,KTKAM,KTPHI,KTLIAA,KTEMP,
  50.      &                  KTLIAB,KTFEX,KTPAS,KTRES,KTNUM,IPMAIL,REPRIS,
  51.      &                  KPARNUM,KSORT,ICHAIN,KOCLFA,KOCLB1,NHBM,NFFT)
  52.  
  53.       IMPLICIT INTEGER(I-N)
  54.       IMPLICIT REAL*8(A-H,O-Z)
  55.  
  56. -INC PPARAM
  57. -INC CCOPTIO
  58. -INC CCREEL
  59.  
  60. -INC SMCOORD
  61. -INC SMMODEL
  62. -INC SMELEME
  63. -INC SMCHAML
  64. -INC SMLENTI
  65. -INC SMCHPOI
  66.  
  67. -INC TMDYNC
  68.  
  69.       LOGICAL L0,L1,REPRIS
  70.       CHARACTER*6  MO2
  71.       CHARACTER*8  TYPRET,CHARRE,CHARR0
  72.       CHARACTER*10 MO1
  73.       CHARACTER*40 MONMOT
  74.  
  75.       ITREP  = 0
  76.       MTQ    = 0
  77.       MTKAM  = 0
  78.       MTPHI  = 0
  79.       MTLIAA = 0
  80.       MTEMP  = 0
  81.       MTLIAB = 0
  82.       MTFEX  = 0
  83.       MTPAS  = 0
  84.       MTNUM  = 0
  85.       MTRA   = 0
  86.       PARNUM = 0
  87.       PSORT  = 0
  88.       XTINI  = 0.D0
  89.       ITLA = 0
  90.       ITLB = 0
  91. c       NNNN = 0
  92.       REPRIS = .FALSE.
  93.  
  94.  
  95. ************************************************************************
  96. *     Recherche du nombre de modes: autant que de points de reference
  97. ************************************************************************
  98.       IF (IIMPI.EQ.333) write(IOIMP,*) 'HBMALO: recup des modes'
  99. *
  100.       MPREF = KPREF
  101.       NPREF = IPOREF(/1)
  102.       NA1   = NPREF
  103.  
  104. c     on intialise NB1 a 1; le segment sera eventuellement ajuste
  105. c     lors du remplissage par D2VTRA
  106.       NB1  = 1
  107.       NB1K = 1
  108.       NB1C = 1
  109.       NB1M = 1
  110.       nl1 = 2*NHBM+1
  111.       NT1 = nl1*na1
  112. ** FORMULE INTELLIGENTE A TROUVER
  113.       NPC1 = NFFT
  114.       NPC2 = 40*NFFT
  115.  
  116. **===============================
  117.       SEGINI,MTQ,MTKAM
  118.       SEGINI,LOCLFA
  119.       SEGINI,MTEMP
  120. c       SEGINI,NNNN
  121.       KTEMP = MTEMP
  122.       KOCLFA = LOCLFA
  123.       KTQ   = MTQ
  124.       KTKAM = MTKAM
  125.  
  126. *     Transformees de Fourier Inverse/Directe
  127. *     Pour la continuation: GAM,IGAM
  128.       CALL AFTM(NPC1,NHBM,GAM,IGAM,DL)
  129. **     Pour la stabilite: GAMFIN si besoin de + de points
  130. *      CALL AFTM(NPC2,NHBM,GAMFIN,IGAM2,DL2)
  131. c       SEGDES,NNNN
  132.  
  133. **********************************************************************
  134. *     Segment des parametres numeriques:
  135. *     on renseigne ici seulement TYPS
  136. *     d'apres 'TYPE' = FORCe ou AUTOnome ou NonNormalMode?
  137. **********************************************************************
  138.       SEGINI, PARNUM
  139.       KPARNUM = PARNUM
  140.       IF (IPARNUM.gt.0) THEN
  141.         CALL ACCTAB(IPARNUM,'MOT',I0,X0,'TYPE',L0,IP0,
  142.      &                      'MOT',I1,X1,CHARRE,L1,IP1)
  143.         IF(IERR.NE.0) RETURN
  144.         TYPS(1:4) = CHARRE(1:4)
  145.       ELSE
  146. c       valeur par defaut (pas super)
  147.         TYPS(1:4) = 'FORC'
  148.       ENDIF
  149. c     verif
  150.       IF(TYPS.NE.'FORC' .AND. TYPS.NE.'AUTO' .AND.TYPS.NE.'NNM') THEN
  151. c         On a lu %m1:8, alors qu'on attend un des mots cles suivant :
  152. c         %m9:16 %m17:24 %m25:32 %m33:40. Consulter la notice.
  153.           MOTERR(1:4)=TYPS(1:4)
  154.           MOTERR(5:8)='    '
  155.           MOTERR(9:40)='FORC    AUTO    NNM     '
  156.           CALL ERREUR(930)
  157.           RETURN
  158.       ENDIF
  159.  
  160. ************************************************************************
  161. *     Table INITIAL --> Initialisation du vecteur des inconnues
  162. ************************************************************************
  163.  
  164.       IF (ITINIT.GT.0) THEN
  165.  
  166. ******* Cas d'une reponse FORCee ou d'un systeme AUTOnome *******
  167.         IF (TYPS.EQ.'FORC' .OR. TYPS.EQ.'AUTO') THEN
  168.  
  169. c         TINIT . jharm . imode  = valeur (flottant)  -> idem sortie
  170. c         TINIT . jharm  = chpoint                    -> idem chargement
  171. c         boucle sur les harmoniques
  172.           DO KHBM=-1*NHBM,NHBM
  173.             TYPRET = ' '
  174.             CALL ACCTAB(ITINIT,'ENTIER',KHBM,X0,CHARR0,L0,IP0,
  175.      &                  TYPRET,I1,X1,CHARRE,L1,IP1)
  176.             IF(IERR.NE.0) RETURN
  177. *          -cas d'une table de CHPOINT
  178.             IF(TYPRET.EQ.'CHPOINT ') THEN
  179.               MCHPOI=IP1
  180.               SEGACT,MCHPOI
  181.               NSOUPO=IPCHP(/1)
  182. c             boucle sur les zones (definies a partir des noms de composantes)
  183.               DO I=1,NSOUPO
  184.                  MSOUPO = IPCHP(I)
  185.                  SEGACT,MSOUPO
  186. c                on recupere le maillage
  187.                  MELEME = IGEOC
  188.                  SEGACT,MELEME
  189. c                NC = nombre de composantes
  190.                  NC = NOCOMP(/2)
  191.                  IF(NC.NE.1) THEN
  192. c                  Il faut specifier un champ par point avec une seule composante
  193.                    CALL ERREUR(180)
  194.                    RETURN
  195.                  ENDIF
  196.                  MPOVAL = IPOVAL
  197.                  SEGACT,MPOVAL
  198. c                VPOCHA(i,j) = valeur au noeud i de la composante j
  199.                  N = VPOCHA(/1)
  200.                  DO J=1,N
  201. c                   on cherche le #noeud dans IPOREF
  202.                     KNOE = NUM(1,J)
  203.                     CALL PLACE2(IPOREF,NPREF,IPOS,KNOE)
  204. c                   IPOS est le numero (local) de mode
  205.                     IF (IPOS.NE.0) THEN
  206. c                       DO K=1,NC
  207.                         K=1
  208.                           IF (KHBM.LE.0) THEN
  209.                             IND1=2*ABS(KHBM)
  210.                           ELSE
  211.                             IND1=2*ABS(KHBM)-1
  212.                           ENDIF
  213.                           IND=NA1*IND1+IPOS
  214. c                         normalement, on ne peut/doit definir qu'1 fois Q1 initial
  215.                           Q1(IND) = VPOCHA(J,K)
  216. c                       ENDDO
  217.                     ENDIF
  218.                  ENDDO
  219.                  SEGDES,MPOVAL,MELEME,MSOUPO
  220.               ENDDO
  221.               SEGDES,MCHPOI
  222. c *          -cas d'une table de TABLE
  223. c             ELSEIF(TYPRET.EQ.'TABLE   ') THEN
  224. c             TODO
  225.             ELSEIF(TYPRET.NE.' ') THEN
  226. c              On ne veut pas d'objet de type %m1:8
  227.                MOTERR(1:8)=TYPRET
  228.                CALL ERREUR(39)
  229.                RETURN
  230.             ENDIF
  231.           ENDDO
  232.  
  233. *         frequence initiale
  234.           CALL ACCTAB(ITINIT,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  235.      &                                 'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  236.           IF(IERR.NE.0) RETURN
  237.           OMEG   = X1
  238.  
  239. ******* Cas d'une reponse FORCee ou d'un systeme AUTOnome *******
  240.         ELSEIF (TYPS.EQ.'NNM') THEN
  241.  
  242. *         mode lineaire considere comme point initial
  243.           CALL ACCTAB(ITINIT,'MOT',I0,X0,'MODE',L0,IP0,
  244.      &                       'ENTIER',I1,X1,CHARRE,L1,IP1)
  245.           IF(IERR.NE.0) RETURN
  246.           JMODE=I1
  247. c         OMEG sera rempli lors du parcours de la base ....
  248. *         energie initiale du mode (doit etre assez faible ~quasi-nulle)
  249.           CALL ACCTAB(ITINIT,'MOT',I0,X0,'ENERGIE',L0,IP0,
  250.      &                       'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  251.           XPARA  = ABS(X1)
  252.           IF(XPARA.le.XPETIT) THEN
  253. c           La valeur de %M1:8 doit etre positive
  254.             MOTERR(1:8)='ENERGIE '
  255.             CALL ERREUR(549)
  256.             RETURN
  257.           ENDIF
  258. *         Par defaut, on initialise selon la composante cos Wt (les autres=0)
  259. *         (on aurait pu initialiser sin Wt)
  260.           Q1(NA1+JMODE)=SQRT(XPARA)
  261.  
  262.         ELSE
  263.  
  264.         ENDIF
  265.  
  266.       ENDIF
  267.  
  268. ************************************************************************
  269. *     Parametres temporels: pas de temps constant
  270. ************************************************************************
  271.       NPC=1
  272.  
  273. ************************************************************************
  274. *     Gestion des segments descriptifs des liaisons
  275. ************************************************************************
  276.       IF (IIMPI.EQ.333) write(IOIMP,*) 'HBMALO: recup des liaisons'
  277. *
  278.       NLIAA  = 0
  279.       NIPALA = 0
  280.       NXPALA = 0
  281.       NPLAA  = 0
  282.       NPLA   = 0
  283.       NLIAB  = 0
  284.       NIPALB = 0
  285.       NXPALB = 0
  286.       NIP    = 0
  287.       NPLBB  = 0
  288.       NPLB   = 0
  289.       NPLSB  = 0
  290.       IDIMB  = 0
  291.       NA2    = 0
  292.       NSB    = 0
  293.       KCPR   = 0
  294.       NTVAR  = 6 + 4 * IDIM
  295. *
  296. *     MTRA indiquera la presence de liaisons POLYNOMIALEs
  297. *     (on suppose un maximum de 100 liaisons en base A)
  298. *+*   passe a 10000 le 28/1/93
  299.       NTRA   = 10000
  300.       SEGINI,MTRA
  301. *
  302.       IF (ITLIA.NE.0) THEN
  303. *
  304.          TYPRET = ' '
  305.          CALL ACCTAB(ITLIA,'MOT',I0,X0,'LIAISON_A',L0,IP0,
  306.      &                    TYPRET,I1,X1,CHARRE,L1,ITLA)
  307.          IF (IERR.NE.0) RETURN
  308. *
  309. *        Liaisons sur la base A : determination des parametres
  310. *
  311.          IF (ITLA.NE.0) THEN
  312.             IF (TYPRET.EQ.'TABLE   ') THEN
  313.                CALL DYNE21(ITLA,PDT,MTRA,KLIAA,KXPALA,KPLAA,KIPALA)
  314. *               WRITE(*,*) 'KXPALA=',KXPALA
  315.                IF (IERR.NE.0) RETURN
  316.                NLIAA  = KLIAA
  317.                NIPALA = KIPALA
  318.                NXPALA = KXPALA
  319.                NPLAA  = KPLAA
  320.                NPLA   = NA1
  321.             ELSE
  322.                CALL ERREUR(492)
  323.                RETURN
  324.             ENDIF
  325.          ENDIF
  326. *
  327. *        Liaisons sur la base B : determination des parametres
  328. *
  329.          TYPRET = ' '
  330.          CALL ACCTAB(ITLIA,'MOT',I0,X0,'LIAISON_B',L0,IP0,
  331.      &                    TYPRET,I1,X1,CHARRE,L1,ITLB)
  332.          IF (IERR.NE.0) RETURN
  333.          IF (ITLB.NE.0) THEN
  334.             IF (TYPRET.EQ.'TABLE   ') THEN
  335.                CALL DYNE22(ITLB,KLIAB,KXPALB,KPLBB,KPLB,KDIMB,KCPR,
  336.      &                     KIPALB,KNIP)
  337. *           WRITE(*,*) 'KXPALB=',KXPALB
  338.                IF (IERR.NE.0) RETURN
  339.                NLIAB  = KLIAB
  340.                NIPALB = KIPALB
  341.                NXPALB = KXPALB
  342.                NPLBB  = KPLBB
  343.                NPLB   = KPLB
  344.                IDIMB  = KDIMB
  345.                NIP = KNIP
  346.             ELSE
  347.                CALL ERREUR(493)
  348.                RETURN
  349.             ENDIF
  350.          ENDIF
  351.       ENDIF
  352.       SEGINI,LOCLB1
  353.       KOCLB1 = LOCLB1
  354. *
  355. *     Les segments seront remplis dans le s-p DEVLIA:
  356. *
  357.       SEGINI,MTLIAA
  358.       SEGINI,MTLIAB
  359.       KTLIAA = MTLIAA
  360.       KTLIAB = MTLIAB
  361.       IF (NLIAB.NE.0) THEN
  362.          NCPR = KCPR
  363.          IN = 0
  364.          DO I = 1,NBPTS
  365.             IF (NCPR(I).NE.0) THEN
  366.                IN = IN + 1
  367.                JPLIB(IN) = I
  368.             ENDIF
  369.          ENDDO
  370.          SEGSUP,NCPR
  371.       ENDIF
  372.  
  373. ************************************************************************
  374. *     Segment des deformees modales:
  375. ************************************************************************
  376.       IF (IIMPI.EQ.333) write(IOIMP,*) 'HBMALO: recup deformees modales'
  377.  
  378. ***** Cas table BASE_MODALE et RAIDEUR_ET_MASSE *****
  379.  
  380.       IF (ITKM.GT.0) THEN
  381.          TYPRET = ' '
  382.          CALL ACCTAB(ITKM,'MOT',I0,X0,'BASE_MODALE',L0,IP0,
  383.      &               TYPRET,I1,X1,CHARRE,L1,ITBAS2)
  384.       ELSE
  385.          ITBAS2=ITBAS
  386.       ENDIF
  387.  
  388.       IF (ITBAS2.NE.0) THEN
  389.         CALL ACCTAB(ITBAS2,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  390.      &                     'MOT',I1,X1,MONMOT,L1,IP1)
  391.         IF (IERR.NE.0) RETURN
  392.         IF (IIMPI.EQ.333) write(IOIMP,*) ITBAS2,'de SOUSTYPE',MONMOT
  393. *
  394. *      -Cas ou la base est unique
  395.         IF (MONMOT(1:11).EQ.'BASE_MODALE') THEN
  396.           NSB = 1
  397.           NA2 = NA1
  398. *         changement de dimension en cas de corps rigide
  399.           CALL ACCTAB(ITBAS2,'MOT',I0,X0,'MODES',L0,IP0,
  400.      &                    'TABLE',I1,X1,' ',L1,IBAS)
  401.           IP = 0
  402.  22       CONTINUE
  403.             IP = IP + 1
  404.             TYPRET = ' '
  405.             CALL ACCTAB(IBAS,'ENTIER',IP,X0,' ',L0,IP0,
  406.      &                        TYPRET,I1,X1,CHARRE,L1,ITP1)
  407.             IF (IERR.NE.0) RETURN
  408.             IF (TYPRET.NE.'TABLE') GOTO 23
  409.             IF (ITP1.LE.0)         GOTO 23
  410. c           s'agit-il d'un corps rigide ?
  411.             TYPRET = ' '
  412.             CALL ACCTAB(ITP1,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0,
  413.      &                        TYPRET,I1,X1,MONMOT,L1,IP1)
  414.             IF (IERR.NE.0) RETURN
  415.             IF (TYPRET.EQ.'MOT') THEN
  416.               IF (MONMOT(1:4).EQ.'VRAI') THEN
  417.                 if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3
  418.                 if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6
  419.                 GOTO 23
  420.               ENDIF
  421.             ENDIF
  422. c           cas NNM : on veut recuperer la frequence du mode lineaire
  423. c                     initial -> OMEG
  424.             IF(TYPS.EQ.'NNM ' .AND. IP.EQ.JMODE) THEN
  425.               CALL ACCTAB(ITP1,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  426.      &                         'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  427.               IF (IERR.NE.0) RETURN
  428.               OMEG = 2.D0*XPI * X1
  429.             ENDIF
  430.           GOTO 22
  431.  23       CONTINUE
  432. *      -Cas ou la base est un ensemble de bases
  433.         ELSE
  434.           IB = 0
  435.           NA2 = 0
  436. *         changement de dimension en cas de corps rigide
  437.           IR = 0
  438.  30       CONTINUE
  439.             IB = IB + 1
  440. c             write(ioimp,*) IB,'ieme base de l ensemble'
  441.             TYPRET = ' '
  442.             CALL ACCTAB(ITBAS2,'ENTIER',IB,X0,' ',L0,IP0,
  443.      &                         TYPRET,I1,X1,CHARRE,L1,ITBB)
  444.             IF (IERR.NE.0) RETURN
  445. c         --cas lecture table de la IB ieme base modale ok
  446.             IF (ITBB.NE.0) THEN
  447.             IF (TYPRET.EQ.'TABLE   ') THEN
  448.                CALL ACCTAB(ITBB,'MOT',I0,X0,'MODES',L0,IP0,
  449.      &                        'TABLE',I1,X1,' ',L1,IBAS)
  450.                IF (IERR.NE.0) RETURN
  451.                NNA2 = 0
  452.                IP = 0
  453.  32            CONTINUE
  454.                  IP = IP + 1
  455. c             write(ioimp,*) '  +',IP,'ieme mode de la ',IB,'ieme base'
  456.                  TYPRET = ' '
  457.                  CALL ACCTAB(IBAS,'ENTIER',IP,X0,' ',L0,IP0,
  458.      &                            TYPRET,I1,X1,CHARRE,L1,ITPP)
  459.                  IF (IERR.NE.0) RETURN
  460. c              --cas lecture table du IP ieme mode ok
  461.                  IF (ITPP.NE.0) THEN
  462.                  IF (TYPRET.EQ.'TABLE   ') THEN
  463. *                 changement de dimension en cas de corps rigide
  464.                   IF (IR.GT.1) GOTO 24
  465.                   TYPRET = ' '
  466.                   CALL ACCTAB(ITPP,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0,
  467.      &                    TYPRET,I1,X1,MONMOT,L1,IP1)
  468.                   IF (IERR.NE.0) RETURN
  469.                   IF (TYPRET.EQ.'MOT') THEN
  470.                     IF (MONMOT(1:4).EQ.'VRAI') THEN
  471.                       if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3
  472.                       if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6
  473.                     ENDIF
  474.                   ENDIF
  475.  24               CONTINUE
  476.                   NNA2 = NNA2 + 1
  477.                   GOTO 32
  478. c              --fin du cas lecture table du IP ieme mode ok
  479.                  ELSE
  480.                     CALL ERREUR(491)
  481.                     RETURN
  482.                  ENDIF
  483.                  ENDIF
  484. c              --fin du cas lecture table du IP ieme mode non ok
  485.                NA2 = MAX(NNA2,NA2)
  486.                GOTO 30
  487. c         --fin du cas lecture table de la IB ieme base modale ok
  488.             ELSE
  489.                CALL ERREUR(491)
  490.                RETURN
  491.             ENDIF
  492.             ENDIF
  493. c         --fin du cas lecture table de la IB ieme base modale non ok
  494.           NSB = IB - 1
  495.         ENDIF
  496. *      -fin distinction base modale simple / ensemble de bases
  497.         NPLSB = NPLB
  498.       ENDIF
  499.       NPLSB=1
  500.       SEGINI,MTPHI
  501.       KTPHI = MTPHI
  502. *
  503. ************************************************************************
  504. *     Variables au cours d'un pas de temps:
  505. ************************************************************************
  506.       IF (IIMPI.EQ.333) write(IOIMP,*) 'HBMALO: SEGINI,MTPAS'
  507. *
  508.       MTPAS  = 0
  509. *       write(*,*) NA1,NPLB,IDIMB,NLIAA,NLIAB,NTVAR,IDIM,NPLB
  510.       SEGINI,MTPAS
  511.       KTPAS = MTPAS
  512.  
  513. ************************************************************************
  514. *     Initialisation du segment representant les chargements ( bases A
  515. *     et B ):
  516. ************************************************************************
  517. *
  518.       IF (ITCHAR.GT.0) THEN
  519. c       NT1 deja dimensionne
  520.         SEGINI,MTFEX
  521.         KTFEX = MTFEX
  522.         TYPRET = ' '
  523.         CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BALOURD',L0,IP0,
  524.      &                                      TYPRET,ICH,X1,CHARRE,L1,IP1)
  525.         IF (TYPRET.EQ.'ENTIER') THEN
  526.               BAL = ICH
  527.         ELSE
  528.               BAL = 0
  529.         ENDIF
  530. c       boucle sur les harmoniques
  531.         DO KHBM=-1*NHBM,NHBM
  532.             TYPRET = ' '
  533.             CALL ACCTAB(ITCHAR,'ENTIER',KHBM,X0,CHARR0,L0,IP0,
  534.      &                  TYPRET,I1,X1,CHARRE,L1,IP1)
  535. c            WRITE(IOIMP,*) 'HBMALO, Chargement. KHBM:',KHBM
  536. c            WRITE(IOIMP,*) '-------------------------',TYPRET
  537.             IF (TYPRET.EQ.'CHARGEME') THEN
  538. c On ne veut pas d'objet de type %m1:8
  539.                 MOTERR(1:8)='CHARGEME'
  540.                 CALL ERREUR(39)
  541.                 RETURN
  542.             ELSEIF(TYPRET.EQ.'CHPOINT ') THEN
  543.               MCHPOI=IP1
  544.               SEGACT,MCHPOI
  545.               NSOUPO=IPCHP(/1)
  546. c             boucle sur les zones (definies a partir des noms de composantes)
  547.               DO I=1,NSOUPO
  548.                  MSOUPO = IPCHP(I)
  549.                  SEGACT,MSOUPO
  550. c                on recupere le maillage
  551.                  MELEME = IGEOC
  552.                  SEGACT,MELEME
  553. c                NC = nombre de composantes
  554.                  NC = NOCOMP(/2)
  555.                  MPOVAL = IPOVAL
  556.                  SEGACT,MPOVAL
  557. c                VPOCHA(i,j) = valeur au noeud i de la composante j
  558.                  N = VPOCHA(/1)
  559.                  DO J=1,N
  560.                     DO K=1,NC
  561. c                      on cherche le #noeud dans IPOREF
  562.                        KNOE = NUM(1,J)
  563. c                      WRITE(IOIMP,*) 'KNOE=',KNOE
  564.                        CALL PLACE2(IPOREF,NPREF,IPOS,KNOE)
  565. *                     write(IOIMP,*) J,'eme noeud #',KNOE,' = mode',IPOS
  566. c                    IPOS est le numero de mode
  567. c                    WRITE(IOIMP,*) 'IPOS=',IPOS
  568. c                    WRITE(IOIMP,*) 'VPOCHA=',VPOCHA(J,K),'J=',J,',K=',K
  569.                        IF (IPOS.NE.0) THEN
  570.                           XFORCA = VPOCHA(J,K)
  571.                           IF (KHBM.le.0) then
  572.                             IND1=2*ABS(KHBM)
  573.                           else
  574.                             IND1=2*ABS(KHBM)-1
  575.                           endif
  576.                           IND=NA1*IND1+IPOS
  577. c                         WRITE(IOIMP,*) 'FEXA(',IND,')=',XFORCA
  578. c                         comme c'est constant on somme
  579.                           FEXA(IND) = FEXA(IND) + XFORCA
  580.                        ENDIF
  581.                     ENDDO
  582.                  ENDDO
  583.                  SEGDES,MPOVAL,MELEME,MSOUPO
  584.               ENDDO
  585.               SEGDES,MCHPOI
  586.             ENDIF
  587. c               On ne veut pas d'objet de type %m1:8
  588. c                MOTERR(1:8)=TYPRET
  589. c                CALL ERREUR(39)
  590. c                RETURN
  591. c            ENDIF
  592.         ENDDO
  593. *       mise a 0 de FEXPSM
  594.         do i1=1,NPLB
  595.         do i2=1,NPC1
  596.         do i3=1,2
  597.         do i4=1,IDIMB
  598.           FEXPSM(i1,i2,i3,i4)=0.D0
  599.         enddo
  600.         enddo
  601.         enddo
  602.         enddo
  603.       ELSE
  604.         SEGINI,MTFEX
  605.         KTFEX = MTFEX
  606.         DO I=1,Q1(/1)
  607.             FEXA(I) = 0.
  608.         ENDDO
  609.       ENDIF
  610. c     fin du cas ITCHAR existe ou pas
  611.  
  612. **********************************************************************
  613. *     Segment des parametres numeriques:
  614. **********************************************************************
  615. c       SEGINI, PARNUM
  616. c       KPARNUM = PARNUM
  617. c deplace + haut
  618.       IF (IPARNUM.GT.0) THEN
  619.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'DS0',L0,IP0,
  620.      &                                  'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  621.           DS = X1
  622.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'DSMAX',L0,IP0,
  623.      &                               'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  624.           DSMAX=X1
  625.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'DSMIN',L0,IP0,
  626.      &                              'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  627.           DSMIN=X1
  628.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'ANGLE_MIN',L0,IP0,
  629.      &                              'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  630.           ANGMIN=X1
  631.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'ANGLE_MAX',L0,IP0,
  632.      &                               'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  633.           ANGMAX=X1
  634.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'ITERMOY',L0,IP0,
  635.      &                               'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  636.           ITERMOY=X1
  637.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'ITERMAX',L0,IP0,
  638.      &                               'ENTIER',I1,X1,CHARRE,L1,IP1)
  639.           ITERMAX=I1
  640.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'NBPAS',L0,IP0,
  641.      &                               'ENTIER',I1,X1,CHARRE,L1,IP1)
  642.           NBPAS=I1
  643.           NPAS =I1
  644.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'ISENS',L0,IP0,
  645.      &                               'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  646.           ISENS=X1
  647.           TYPRET = ' '
  648.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'CALCUL_JAC',L0,IP0,
  649.      &                                 TYPRET,I1,X1,CHARRE,L1,IP1)
  650.           IF (TYPRET.EQ.'LOGIQUE') THEN
  651.              JANAL = L1
  652.           ELSE
  653.              JANAL = .FALSE.
  654.           ENDIF
  655.           TYPRET = ' '
  656.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'TOLERANCE',L0,IP0,
  657.      &                                 TYPRET,I1,X1,CHARRE,L1,IP1)
  658.           IF (TYPRET.EQ.'FLOTTANT') THEN
  659.              TOLMIN = X1
  660.           ELSE
  661.              TOLMIN = 1.E-8
  662.           ENDIF
  663.       ENDIF
  664. c
  665. c *     Type = FORCe ou AUTOnome ou NonNormalMode?
  666. c       CALL ACCTAB(IPARNUM,'MOT',I0,X0,'TYPE',L0,IP0,
  667. c      &                                        'MOT',I1,X1,CHARRE,L1,IP1)
  668. c       TYPS(1:4) = CHARRE(1:4)
  669. c ==> deplace + haut
  670.  
  671.       IF (TYPS.EQ.'FORC') THEN
  672. *     Le parametre de continuation sera la frequence de forcage
  673. *     (option par defaut pour l'instant).
  674.           PARINI = OMEG
  675.           XPARA  = PARINI
  676.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'VAL_FIN',L0,IP0,
  677.      &                        'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  678.           PARFIN = X1
  679.       ELSEIF (TYPS.EQ.'AUTO') THEN
  680. *         Continuation par rapport à un autre parametre.
  681. *         On utilise comme frequence celle des conditions initiales.
  682. *         On a besoin des bornes initiales et finales
  683.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'VAL_INI',L0,IP0,
  684.      &                        'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  685.           PARINI = X1
  686.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'VAL_FIN',L0,IP0,
  687.      &                        'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  688.           PARFIN = X1
  689.       ELSEIF (TYPS.EQ.'NNM') THEN
  690. *         Calcul de mode non lineaire.
  691. *         La branche est suivie jusqu'a un certain niveau d'energie.
  692.           CALL ACCTAB(IPARNUM,'MOT',I0,X0,'VAL_FIN',L0,IP0,
  693.      &                        'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  694.           PARINI = XPARA
  695.           PARFIN = X1
  696.       ENDIF
  697. *     test pas cher
  698.       IF (abs(PARINI-PARFIN).le.(XZPREC**0.5)) THEN
  699. c         Les valeurs des parametres doivent etre distinctes
  700.           CALL ERREUR(402)
  701.           RETURN
  702.       ENDIF
  703.  
  704. c *     valeur initiale (selon sens de parcours)
  705. c       IF (ISENS.LT.0.) THEN
  706. c         XPARA = PARFIN
  707. c       ELSE
  708. c         XPARA = PARINI
  709. c       ENDIF
  710. cbp : ci-dessus desormais inutile car on utilise la table "INITIALE"
  711. cbp : PAR_INI et PAR_FIN ne sont plus necessairement ordonnes
  712.  
  713. **********************************************************************
  714. *     Tableau des resultats :
  715. **********************************************************************
  716.        NBIFU=MIN(NPAS/2+1,100)
  717.        SEGINI, PSORT
  718.        KSORT= PSORT
  719.  
  720. ************************************************************************
  721. *    Impressions :
  722. ************************************************************************
  723.       IF (IIMPI.GE.333) THEN
  724.  
  725.          WRITE(IOIMP,*) 'Frequence initiale: W0 =',OMEG
  726.          WRITE(IOIMP,*) 'Le systeme est de type: ',TYPS
  727. *        DO i=1,Q1(/1)
  728. *          write(*,*) 'Q1 initial=',(Q1(i))
  729. *        ENDDO
  730.  
  731.          WRITE(IOIMP,*)'   segment MTLIAB'
  732.          WRITE(IOIMP,*)'     NLIAB  =',IPALB(/1)
  733.          WRITE(IOIMP,*)'     NIPALB =',IPALB(/2)
  734.          WRITE(IOIMP,*)'     NXPALB =',XPALB(/2)
  735.          WRITE(IOIMP,*)'     NPLBB  =',IPLIB(/2)
  736.          WRITE(IOIMP,*)'     NPLB   =',JPLIB(/1)
  737.          WRITE(IOIMP,*)'     NIP    =',XABSCI(/2)
  738. *
  739.          WRITE(IOIMP,*)'   segment MTLIAA'
  740.          WRITE(IOIMP,*)'     NLIAA  =',IPALA(/1)
  741.          WRITE(IOIMP,*)'     NIPALA =',IPALA(/2)
  742.          WRITE(IOIMP,*)'     NXPALA =',XPALA(/2)
  743.          WRITE(IOIMP,*)'     NPLAA  =',IPLIA(/2)
  744.          WRITE(IOIMP,*)'     NPLA   =',JPLIA(/1)
  745. *
  746.          WRITE(IOIMP,*)'   segment MTFEX : chargement frequentiel'
  747.          IF (BAL.EQ.1)WRITE(IOIMP,*)'de type balourd'
  748.          DO i=1,FEXA(/1)
  749.             write(IOIMP,*) 'FEXA(',i,',:)=',(FEXA(i))
  750.          ENDDO
  751.       ENDIF
  752. *
  753.       RETURN
  754.       END
  755.  
  756.  
  757.  

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