Télécharger la plaquette Cast3M


fr en

Télécharger dyne74.eso

Retour à la liste

Numérotation des lignes : 

dyne74

  1. C DYNE74    SOURCE    CB215821  24/04/12    21:15:39     11897          
  2.       SUBROUTINE DYNE74(ITSORT,ITCARA,ITABL,ITLIA,KTRAV,II,NLS,NVAR)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     Operateur DYNE : algorithme de Fu - de Vogelaere               *
  8. *     ________________________________________________               *
  9. *                                                                    *
  10. *     Dimensionne les variables NLS et NVAR, gestion des demandes de *
  11. *     sorties pour les liaisons.                                     *
  12. *                                                                    *
  13. *     Parametres:                                                    *
  14. *                                                                    *
  15. * e   ITABL   Table definissant les liaisons en sortie.              *
  16. * e   ITLIA   Table definissant toutes les liaisons sur une base.    *
  17. * e   KTRAV   Segment de travail qui va remplir MTRES dans DYNE15    *
  18. * es  II      Compteur                                               *
  19. * s   NLS     Nombre de demandes de liaisons en sortie               *
  20. * s   NVAR    Nombre maxi de variables internes de liaisons          *
  21. *                                                                    *
  22. *                                                                    *
  23. *     Auteur, date de cr{ation:                                      *
  24. *                                                                    *
  25. *     d après Lionel VIVAN, le 2 octobre 1989.                       *
  26. *                                                                    *
  27. *--------------------------------------------------------------------*
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMMODEL
  32. -INC SMCHAML
  33. *
  34.       SEGMENT,MTRAV
  35.          INTEGER ICHRE2(NBLS),MPOLA(NBLS),MNULA(NBLS)
  36.          INTEGER MPOLB(NBLS),MNULB(NBLS)
  37.          INTEGER IVLIAA(NBLS,NTVAR),INLIAA(NBLS,NTVAR)
  38.          INTEGER IVLIAB(NBLS,NTVAR),INLIAB(NBLS,NTVAR)
  39.       ENDSEGMENT
  40. *
  41.       LOGICAL L0,L1,LVAR
  42.       CHARACTER*8  MONMOT,TYPRET,CHARRE,CMATE
  43.       CHARACTER*40 CMOT
  44.       CHARACTER*4  MO4
  45. *
  46.       CMOT=' '
  47.       MTRAV = KTRAV
  48.       NLS  = 0
  49.       NVAR = 0
  50.       mmodel = itlia
  51.  
  52. * table indicée par des entiers
  53.          CALL DIMEN7 (ITABL,IDIMEN)
  54.  
  55.       mmodel = itlia
  56.       segact mmodel
  57.       mchelm = itcara
  58.       segact mchelm
  59.       segact mmodel
  60. *
  61. *     recherche des liaisons en sortie : faire une table index de la tsortie.liaison
  62. *
  63.       INDICE = 0
  64.       IVAR   = 0
  65.  100  CONTINUE
  66.       INDICE = INDICE + 1
  67.       TYPRET = ' '
  68.       CALL ACCTAB(ITABL,'ENTIER',INDICE,X0,' ',L0,IP0,
  69.      &                  TYPRET,I1,X1,CHARRE,L1,ITTL)
  70.       IF (TYPRET.EQ.'MMODEL  ' .AND. ITTL.NE.0) THEN
  71.          TYPRET = ' '
  72.          CALL ACCTAB(ITSORT,'MMODEL  ',I0,X0,' ',L0,ITTL,
  73.      &                     TYPRET,I1,X1,CHARRE,LVAR,ITVAR)
  74.          mmode1 = ittl
  75.          segact mmode1
  76. * on attend une liaison elementaire
  77.          imode1 = mmode1.kmodel(1)
  78.          segact imode1
  79.       do ik = 1,kmodel(/1)
  80.        imodel = kmodel(ik)
  81.        segact imodel
  82. *      write(6,*) imodel,imode1,conmod,imode1.conmod,imamod,imode1.imamod
  83.        if (imode1.conmod.eq.conmod.or.imode1.imamod.eq.imamod) goto 110
  84.        segdes imodel
  85.       enddo
  86.           segdes imode1,mmode1
  87.           goto 100
  88.  
  89.  110     continue
  90. *
  91. *        toutes les variables de la liaison sont en sortie
  92. *
  93.          IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR) THEN
  94.             NLS = NLS + 1
  95.             MNULA(NLS) = INDICE
  96.             MPOLA(NLS) = ITTL
  97.             CMATE = CMATEE
  98.             lcham = 0
  99.             MONMOT = ' '
  100.             do im = 1,imache(/1)
  101.               if(imache(im).eq.imamod.and.conche(im).eq.conmod) then
  102.                 mchaml = ichaml(im)
  103.                 lcham = mchaml
  104.                 segact mchaml
  105.                 do l=1,nomche(/2)
  106.                   MO4=nomche(l)
  107.                   if (MO4.eq.'AMOR') MONMOT='FLOTTANT'
  108.                 enddo
  109.                 segdes mchaml
  110.               endif
  111.             enddo
  112. *
  113.  
  114.             IF (CMATE.EQ.'PO_PL_FL') THEN
  115.                IVAR = 6
  116.                NVAR = MAX(NVAR,IVAR)
  117.                II = II + 1
  118.                ICHRE2(II) = IVAR
  119.                IVLIAA(NLS,1) = 1
  120.                INLIAA(NLS,1) = 7
  121.                IVLIAA(NLS,2) = 1
  122.                INLIAA(NLS,2) = 8
  123.                IVLIAA(NLS,3) = 1
  124.                INLIAA(NLS,3) = 69
  125.                IVLIAA(NLS,4) = 1
  126.                INLIAA(NLS,4) = 70
  127.                IVLIAA(NLS,5) = 1
  128.                INLIAA(NLS,5) = 71
  129.                IVLIAA(NLS,6) = 1
  130.                INLIAA(NLS,6) = 72
  131. *
  132.             ELSE IF (CMOT(1:10).EQ.'PO_PL') THEN
  133.                IF (MONMOT.EQ.'FLOTTANT') THEN
  134.                   IVAR = 3
  135.                   IVLIAA(NLS,3) = 1
  136.                   INLIAA(NLS,3) = 39
  137.                ELSE
  138.                   IVAR = 2
  139.                ENDIF
  140.                NVAR = MAX(NVAR,IVAR)
  141.                II = II + 1
  142.                ICHRE2(II) = IVAR
  143.                IVLIAA(NLS,1) = 1
  144.                INLIAA(NLS,1) = 15
  145.                IVLIAA(NLS,4) = 1
  146.                INLIAA(NLS,4) = 7
  147. *
  148.             ELSE IF (CMOT(1:16).EQ.'COUP_VIT') THEN
  149.                IVAR = 3
  150.                NVAR = MAX(NVAR,IVAR)
  151.                II = II + 1
  152.                ICHRE2(II) = IVAR
  153.                IVLIAA(NLS,1) = 1
  154.                INLIAA(NLS,1) = 73
  155.                IVLIAA(NLS,3) = 1
  156.                INLIAA(NLS,3) = 8
  157.                IVLIAA(NLS,4) = 1
  158.                INLIAA(NLS,4) = 7
  159. *
  160.             ELSE IF (CMOT(1:20).EQ.'COUP_DEP') THEN
  161.                IVAR = 2
  162.                NVAR = MAX(NVAR,IVAR)
  163.                II = II + 1
  164.                ICHRE2(II) = IVAR
  165.                IVLIAA(NLS,1) = 1
  166.                INLIAA(NLS,1) = 74
  167.                IVLIAA(NLS,4) = 1
  168.                INLIAA(NLS,4) = 7
  169. *
  170.             ELSE IF (CMOT(1:11).EQ.'POLYNOMI') THEN
  171.                IVAR = 1
  172.                NVAR = MAX(NVAR,IVAR)
  173.                II = II + 1
  174.                ICHRE2(II) = IVAR
  175.                IVLIAA(NLS,1) = 1
  176.                INLIAA(NLS,1) = 77
  177. *
  178.             ELSE
  179.                CALL ERREUR(490)
  180.                RETURN
  181.             ENDIF
  182. *
  183.          ELSE IF (TYPRET.EQ.'TABLE   ' .AND. ITVAR.NE.0) THEN
  184. * kich : on met toutes les variables
  185.           if (.false.) then
  186.             NLS = NLS + 1
  187.             MNULA(NLS) = INDICE
  188.             MPOLA(NLS) = ITTL
  189.             CALL ACCTAB(ITTL,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0,
  190.      &                       'MOT',I1,X1,CMOT,L1,IT1)
  191.             IVAR = 0
  192. *
  193.             IF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN
  194.                TYPRET = ' '
  195.                CALL ACCTAB(ITVAR,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  196.      &                           TYPRET,I1,X1,CHARRE,LVAR,IT1)
  197.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  198.                   IVAR = IVAR + 1
  199.                   IVLIAA(NLS,1) = 1
  200.                   INLIAA(NLS,1) = 7
  201.                ENDIF
  202.                TYPRET = ' '
  203.                CALL ACCTAB(ITVAR,'MOT',I0,X0,'VITESSE',L0,IP0,
  204.      &                           TYPRET,I1,X1,CHARRE,LVAR,IT1)
  205.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  206.                   IVAR = IVAR + 1
  207.                   IVLIAA(NLS,2) = 1
  208.                   INLIAA(NLS,2) = 8
  209.                ENDIF
  210.                TYPRET = ' '
  211.                CALL ACCTAB(ITVAR,'MOT',I0,X0,'MASSE_AJOUTEE',L0,IP0,
  212.      &                           TYPRET,I1,X1,CHARRE,LVAR,IT1)
  213.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  214.                   IVAR = IVAR + 1
  215.                   IVLIAA(NLS,3) = 1
  216.                   INLIAA(NLS,3) = 69
  217.                ENDIF
  218.                TYPRET = ' '
  219.                CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_CONVECTION',L0,IP0,
  220.      &                           TYPRET,I1,X1,CHARRE,LVAR,IT1)
  221.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  222.                   IVAR = IVAR + 1
  223.                   IVLIAA(NLS,4) = 1
  224.                   INLIAA(NLS,4) = 70
  225.                ENDIF
  226.                TYPRET = ' '
  227.                CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_VISCOSITE',L0,IP0,
  228.      &                           TYPRET,I1,X1,CHARRE,LVAR,IT1)
  229.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  230.                   IVAR = IVAR + 1
  231.                   IVLIAA(NLS,5) = 1
  232.                   INLIAA(NLS,5) = 71
  233.                ENDIF
  234.                TYPRET = ' '
  235.                CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_PERTE_DE_CHARGE',
  236.      &                           L0,IP0,TYPRET,I1,X1,CHARRE,LVAR,IT1)
  237.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  238.                   IVAR = IVAR + 1
  239.                   IVLIAA(NLS,6) = 1
  240.                   INLIAA(NLS,6) = 72
  241.                ENDIF
  242.                IF (IVAR.EQ.0) THEN
  243.                   CALL ERREUR(496)
  244.                   RETURN
  245.                ENDIF
  246. *
  247.             ELSE IF (CMOT(1:10).EQ.'POINT_PLAN') THEN
  248.                TYPRET = ' '
  249.                CALL ACCTAB(ITVAR,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  250.      &                           TYPRET,I1,X1,CHARRE,LVAR,IT1)
  251.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  252.                   IVAR = IVAR + 1
  253.                   IVLIAA(NLS,4) = 1
  254.                   INLIAA(NLS,4) = 7
  255.                ENDIF
  256.                TYPRET = ' '
  257.                CALL ACCTAB(ITVAR,'MOT',I0,X0,'VITESSE_NORMALE',L0,IP0,
  258.      &                           TYPRET,I1,X1,CHARRE,LVAR,IT1)
  259.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  260.                   IVAR = IVAR + 1
  261.                   IVLIAA(NLS,3) = 1
  262.                   INLIAA(NLS,3) = 39
  263.                ENDIF
  264.                TYPRET = ' '
  265.                CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_DE_CHOC',L0,IP0,
  266.      &                           TYPRET,I1,X1,CHARRE,LVAR,IT1)
  267.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  268.                   IVAR = IVAR + 1
  269.                   IVLIAA(NLS,1) = 1
  270.                   INLIAA(NLS,1) = 15
  271.                ENDIF
  272.                IF (IVAR.EQ.0) THEN
  273.                   CALL ERREUR(496)
  274.                   RETURN
  275.                ENDIF
  276. *
  277.             ELSE IF (CMOT(1:16).EQ.'COUPLAGE_VITESSE') THEN
  278.                TYPRET = ' '
  279.                CALL ACCTAB(ITVAR,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  280.      &                           TYPRET,I1,X1,CHARRE,LVAR,IT1)
  281.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  282.                   IVAR = IVAR + 1
  283.                   IVLIAA(NLS,4) = 1
  284.                   INLIAA(NLS,4) = 7
  285.                ENDIF
  286.                TYPRET = ' '
  287.                CALL ACCTAB(ITVAR,'MOT',I0,X0,'VITESSE',L0,IP0,
  288.      &                           TYPRET,I1,X1,CHARRE,LVAR,IT1)
  289.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  290.                   IVAR = IVAR + 1
  291.                   IVLIAA(NLS,3) = 1
  292.                   INLIAA(NLS,3) = 8
  293.                ENDIF
  294.                TYPRET = ' '
  295.                CALL ACCTAB(ITVAR,'MOT',I0,X0,
  296.      &                     'FORCE_DE_COUPLAGE_VITESSE',L0,IP0,
  297.      &                     TYPRET,I1,X1,CHARRE,LVAR,IT1)
  298.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  299.                   IVAR = IVAR + 1
  300.                   IVLIAA(NLS,1) = 1
  301.                   INLIAA(NLS,1) = 73
  302.                ENDIF
  303.                IF (IVAR.EQ.0) THEN
  304.                   CALL ERREUR(496)
  305.                   RETURN
  306.                ENDIF
  307. *
  308.             ELSE IF (CMOT(1:20).EQ.'COUPLAGE_DEPLACEMENT') THEN
  309.                TYPRET = ' '
  310.                CALL ACCTAB(ITVAR,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  311.      &                           TYPRET,I1,X1,CHARRE,LVAR,IT1)
  312.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  313.                   IVAR = IVAR + 1
  314.                   IVLIAA(NLS,4) = 1
  315.                   INLIAA(NLS,4) = 7
  316.                ENDIF
  317.                TYPRET = ' '
  318.                CALL ACCTAB(ITVAR,'MOT',I0,X0,
  319.      &                     'FORCE_DE_COUPLAGE_DEPLACEMENT',L0,IP0,
  320.      &                     TYPRET,I1,X1,CHARRE,LVAR,IT1)
  321.                IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
  322.                   IVAR = IVAR + 1
  323.                   IVLIAA(NLS,1) = 1
  324.                   INLIAA(NLS,1) = 74
  325.                ENDIF
  326.                IF (IVAR.EQ.0) THEN
  327.                   CALL ERREUR(496)
  328.                   RETURN
  329.                ENDIF
  330. *
  331.             ELSE IF (CMOT(1:11).EQ.'POLYNOMIALE') THEN
  332.                TYPRET = ' '
  333.                CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_POLYNOMIALE',
  334.      &                     L0,IP0,TYPRET,I1,X1,CHARRE,LVAR,IT1)
  335.                IF (TYPRET.EQ.'LOGIQUE '.AND.LVAR) THEN
  336.                   IVAR = IVAR + 1
  337.                   IVLIAA(NLS,1) = 1
  338.                   INLIAA(NLS,1) = 77
  339.                ENDIF
  340. *
  341.             ELSE
  342.                CALL ERREUR(490)
  343.                RETURN
  344.             ENDIF
  345.             NVAR = MAX(NVAR,IVAR)
  346.             II = II + 1
  347.             ICHRE2(II) = IVAR
  348.             IF (IIMPI.EQ.333) THEN
  349.                WRITE(IOIMP,*)'DYNE24 : ICHRE2(',II,')=',IVAR
  350.             ENDIF
  351. * kich annulation du choix
  352.           endif
  353.          ENDIF
  354.          GOTO 100
  355.       ELSE
  356.        if (indice.le.idimen) goto 100
  357.       ENDIF
  358.       IF (IIMPI.EQ.333) THEN
  359.       WRITE(IOIMP,*) 'DYNE24 : NVAR = ',NVAR
  360.       WRITE(IOIMP,*) 'DYNE24 : NLS  = ',NLS
  361.       WRITE(IOIMP,*) 'DYNE24 : IVAR = ',IVAR
  362.       ENDIF
  363. *
  364.       END
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  

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