Télécharger la plaquette Cast3M


fr en

Télécharger cfl1.eso

Retour à la liste

Numérotation des lignes : 

cfl1

  1. C CFL1      SOURCE    OF166741  25/02/21    21:15:27     12166          
  2.       SUBROUTINE CFL1(IPMODL,IPCHA1,IPCHA2,IPCHA3,IPCHA4,ICAS)
  3. *
  4. *-----------------------------------------------------------------------
  5. *
  6. *    calcul du pas de temps de stabilité operateur CFL
  7. *           de la vitesse du son  operateur CSON
  8. *           de la taille de propagation de l'information opérateur TAILLE
  9. *
  10. * en entrée
  11. *  ipmodl objet model
  12. *  ipcha1 champ de caractéristiques
  13. *  ipcha2 champ de vitesse du son composante 'CSON'
  14. *  ipcha3 champ de taille du maillage composante 'L' ( et 'L2H' facultatif)
  15. *  icas décrit le cas de figure
  16. *            entree            ------->                   sortie
  17. *        = 1 ipcha1                                pas de temps cfl
  18. *        = 2 ipcha2 ( et ipcha1 si cara geom )      "       "      "
  19. *        = 3 ipcha3 et ipcha1                       "       "      "
  20. *        = 4 ipcha1                                vitesse du son
  21. *        = 5 ( et ipcha1 si cara geom )            parametre de taille
  22. * en sortie
  23. *        ipcha4 le champ par element demandé
  24. *
  25. *-----------------------------------------------------------------------
  26. *
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8(A-H,O-Z)
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC CCHAMP
  33. -INC CCGEOME
  34. -INC CCREEL
  35.  
  36. -INC SMCHAML
  37. -INC SMINTE
  38. -INC SMELEME
  39. -INC SMRIGID
  40. -INC SMMODEL
  41. -INC SMCOORD
  42. -INC SMLREEL
  43.  
  44. -INC TMPTVAL
  45.  
  46.       SEGMENT NOTYPE
  47.         CHARACTER*16 TYPE(NBTYPE)
  48.       ENDSEGMENT
  49.  
  50.       CHARACTER*(NCONCH) CONM
  51.       CHARACTER*8 CMATE
  52.       PARAMETER ( NINF=3 )
  53.       INTEGER INFOS(NINF)
  54.       CHARACTER*4 CMOT
  55.       LOGICAL DEUCMP,lsupma
  56.  
  57. *--------------------------------------------------------------------*
  58. *     call tcloc2(' ',-1,it)
  59.       deucmp=.FALSE.
  60.       IF ( ICAS .EQ. 1) THEN
  61.         IPCHE1 =  IPCHA1
  62.         IPCHE2 = 0
  63.       ELSE IF ( ICAS .EQ. 2 ) THEN
  64.         IPCHE1 = IPCHA1
  65.         IPCHE2 = IPCHA2
  66.       ELSE IF ( ICAS .EQ. 3 ) THEN
  67.          IPCHE1 = IPCHA1
  68.          IPCHE2 = IPCHA3
  69.       ELSE IF ( ICAS .EQ. 4 ) THEN
  70.          IPCHE1 = IPCHA1
  71.          IPCHE2 = 0
  72.       ELSE IF ( ICAS .EQ. 5 ) THEN
  73.          IPCHE1 = IPCHA1
  74.          IPCHE2 = 0
  75.       ENDIF
  76.  
  77.       MMODEL = IPMODL
  78.       SEGACT MMODEL
  79.       NSOUS = KMODEL(/1)
  80. *
  81. *  initialisation de l'objet résultat
  82. *
  83.       N1 = NSOUS
  84.       N3 = 6
  85.       L1 = 16
  86.       SEGINI MCHELM
  87.       IF ( ICAS .LE. 3 .OR. ICAS .GE. 1 ) THEN
  88.          TITCHE = 'PAS DE TEMPS CFL'
  89.       ELSE IF ( ICAS .EQ. 4 ) THEN
  90.          TITCHE = 'VITESSE DU SON'
  91.       ELSE IF ( ICAS .EQ. 5 ) THEN
  92.          TITCHE = 'TAILLE CFL'
  93.       ENDIF
  94.  
  95.       IFOCHE = IFOUR
  96. *--------------------------------------------------------------------*
  97. *
  98. *       BOUCLE SUR LES ZONES ELEMENTAIRES ( MEME TYPE D'EF )
  99. *
  100. *--------------------------------------------------------------------*
  101. *
  102.       DO 500 ISOUS=1,NSOUS
  103.         IMODEL=KMODEL(ISOUS)
  104.         SEGACT IMODEL
  105.         lsupma=.true.
  106. *
  107. *    INITIALISATIONS
  108. *
  109.         IVAM1 = 0
  110.         IVAM2 = 0
  111. *
  112.         MELE  = NEFMOD
  113.         IPMAIL= IMAMOD
  114.         CONM  = CONMOD
  115.         NFOR  = FORMOD(/2)
  116.         NMAT  = MATMOD(/2)
  117. *
  118.         IVAMAT=0
  119.         IVACAR=0
  120.         NMATR=0
  121.         NMATF=0
  122.         NCARA=0
  123.         NCARF=0
  124.         MOCARA=0
  125.         MOMATR=0
  126.         DESCR=0
  127.         IMATRI=0
  128. C
  129. C   COQUE INTEGREE OU PAS ?
  130.         NPINT = imodel.INFMOD(1)
  131. *
  132. *    formulation et matériau ( ca peut servir par la suite )
  133. *
  134.         CMATE = imodel.CMATEE
  135.         MATE  = imodel.IMATEE
  136.         INAT  = imodel.INATUU
  137. *
  138. *    information sur l'élément finis : nécessaire pour les tests
  139. *                                      qui donnent les noms de composantes
  140. *
  141.          INTTYP = 2
  142. *
  143.          MFR   = INFELE(13)
  144.          IELE  = INFELE(14)
  145. *         IPINT = INFELE(11)
  146.          ipint=infmod(4)
  147. *
  148. *    Verification de compatibilite de MCHAML du point de vue des
  149. *
  150. *    tableaux INFCHE et creation du tableau INFOS pour COMCHA
  151. *
  152.          CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE1,INFOS,IRTD)
  153.          IF (IRTD.EQ.0) THEN
  154. *                    incompatibilité entre le modele et le chamelem
  155.            SEGSUP MCHELM
  156.            RETURN
  157.          ENDIF
  158.  
  159. *         call tcloc2('Apres ident',6,it)
  160. *
  161. *--------------------------------------------------------------------*
  162. *       determination des noms de composantes dans les champs
  163. *
  164. * on commence par le champ  2  qui n'existe que dans le cas 2 et 3
  165.         NOTYPE = MOTYR8
  166.         IF (ICAS.EQ.2 .OR.ICAS.EQ.3) THEN
  167.              IF (ICAS.EQ.2) THEN
  168. *             le champ 2 contient la vitesse du son
  169.                NBROBL=1
  170.                NBRFAC=0
  171.                SEGINI NOMID
  172.                LESOBL(1)='CSON'
  173.              ELSE IF(ICAS.EQ.3) THEN
  174. *             le champ 2 contient le parametre de taille
  175.                NBROBL=1
  176.                NBRFAC=1
  177.                SEGINI NOMID
  178.                LESOBL(1)='L'
  179.                LESFAC(1) = 'L2H'
  180.               ENDIF
  181.               MOTYPE = NOTYPE
  182.               MOMATR = NOMID
  183. * ===>
  184. *       write(6,*) 'Sous zone' ,isous,' Composante obligatoire ipche2'
  185. *       write(6,7001) (lesobl(i),i=1,nbrobl)
  186. *       write(6,*) 'facultatives'
  187. *       write(6,7001) (lesfac(i),i=1,nbrfac)
  188. * 7001  format(4(A4,2X))
  189. *           Recherche des valeurs des composantes dans les MELVAL d'un
  190. *           CHAMELEM. On distingue les composantes obligatoires des
  191. *            composantes facultatives.
  192.  
  193.           CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAM2)
  194.           SEGSUP,NOMID
  195.           IF (NOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  196.           IF (IERR.NE.0) THEN
  197.             SEGSUP MCHELM
  198.             RETURN
  199.           ENDIF
  200.         ENDIF
  201. *        call tcloc2('Apres komcha1',6,it)
  202. *
  203. *     dans les cas 1,2 ou 5 il peut y avoir des caractéristiques geometriques
  204. *     dans les cas  1,3 ou 4  il y a des caractéristiques matériau
  205. *       on commence par traiter les caractéristiques matériau
  206.         IF (ICAS .EQ. 1 .OR. ICAS .EQ. 3 .OR. ICAS .EQ. 4) THEN
  207.             IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN
  208.                NBROBL=3
  209.                NBRFAC=0
  210.                SEGINI NOMID
  211.                MOMATR=NOMID
  212.                LESOBL(1)='YOUN'
  213.                LESOBL(2)='NU'
  214.                LESOBL(3)='RHO'
  215.                NMATR=NBROBL
  216.                NMATF=NBRFAC
  217.             ELSE
  218.      $      IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN
  219. *               indisponible! pour les volontaies voir voir rigi1.eso
  220. *              SEGSUP MCHELM
  221.                CALL ERREUR(251)
  222.                RETURN
  223.             ELSE
  224.      $      IF (FORMOD(1).EQ.'POREUX   '.AND.CMATE.EQ.'ISOTROPE') THEN
  225. *               indisponible! pour les volontaies voir rigi1.eso
  226.                CALL ERREUR(251)
  227.                SEGSUP MCHELM
  228.                RETURN
  229. *
  230.             ELSEIF(INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN
  231. *               indisponible! pour les volontaies voir rigi1.eso
  232.                SEGSUP MCHELM
  233.                CALL ERREUR(251)
  234.                RETURN
  235. *
  236.             ELSE
  237.               if(lnomid(6).ne.0) then
  238.                nomid=lnomid(6)
  239.                momatr=nomid
  240.                nmatr=lesobl(/2)
  241.                nmatf=lesfac(/2)
  242.                lsupma=.false.
  243.               else
  244.                lsupma=.true.
  245.                CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  246.               endif
  247.             ENDIF
  248. *
  249. *   type des composantes
  250. *
  251.             IF (CMATE.EQ.'SECTION') THEN
  252.                SEGSUP MCHELM
  253.                SEGDES MMODEL,IMODEL
  254.                CALL ERREUR(251)
  255.                RETURN
  256.             ELSE
  257.               MOTYPE=MOTYR8
  258.             ENDIF
  259. *
  260. *  dans le cas ou il y des caractéristiques géometriques on augmente
  261. *  motype
  262. *
  263.           ELSE IF((ICAS.EQ.2 .OR. ICAS.EQ.5).AND.IPCHE1.NE.0)THEN
  264. *  dans ces cas il faut eventuellement récuperer les caractéristiques
  265. *  geométriques et avoir initialiser  notype avant
  266.                NBROBL=0
  267.                NBRFAC=0
  268.                SEGINI NOMID
  269.                MOMATR=NOMID
  270.                MOTYPE=MOTYR8
  271.                NMATR=NBROBL
  272.                NMATF=NBRFAC
  273.          ENDIF
  274. *
  275.          IF((IPCHE1.NE.0).AND.(ICAS.NE.4).AND.(ICAS.NE.3))THEN
  276. *
  277. *
  278. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  279. *
  280.          IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  281.              NBROBL=NBROBL+1
  282.              IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  283.                NBRFAC=NBRFAC+2
  284.              ELSE
  285.                NBRFAC=NBRFAC+1
  286.              ENDIF
  287.              SEGADJ NOMID
  288.              MOCARA=NOMID
  289.              LESOBL(NBROBL)='EPAI'
  290.              LESFAC(NBRFAC)='EXCE'
  291.              IF(MFR.EQ.3.AND.IFOUR.EQ.-2)  THEN
  292.                  LESFAC(NBRFAC-1)='EXCE'
  293.                  LESFAC(NBRFAC)='DIM3'
  294.              ELSE
  295.                  LESFAC(NBRFAC)='EXCE'
  296.              ENDIF
  297. *
  298. * SECTION POUR LES BARRES ET LES CERCES
  299. *
  300.           ELSE IF (MFR.EQ.27) THEN
  301.              NBROBL=NBROBL+1
  302.              SEGADJ NOMID
  303.              LESOBL(NBROBL)='SECT'
  304. *
  305. * section, excentrements et orientation pour les barres excentrees
  306. *
  307.           ELSE IF (MFR.EQ.49) THEN
  308.              NBROBL=NBROBL+6
  309.              SEGADJ NOMID
  310.              LESOBL(NBROBL-5)='SECT'
  311.              LESOBL(NBROBL-4)='EXCZ'
  312.              LESOBL(NBROBL-3)='EXCY'
  313.              LESOBL(NBROBL-2)='VX  '
  314.              LESOBL(NBROBL-1)='VY  '
  315.              LESOBL(NBROBL)='VZ  '
  316. *
  317. * CARACTERISTIQUES POUR LES POUTRES
  318. *
  319.           ELSE IF (MFR.EQ.7 ) THEN
  320.                NBROBL=NBROBL+4
  321.                NBRFAC=NBRFAC+2
  322.                SEGADJ NOMID
  323.                LESOBL(NBROBL-3)='TORS'
  324.                LESOBL(NBROBL-2)='INRY'
  325.                LESOBL(NBROBL-1)='INRZ'
  326.                LESOBL(NBROBL)='SECT'
  327.                LESFAC(NBRFAC-1)='SECY'
  328.                LESFAC(NBRFAC)='SECZ'
  329. *
  330. * CARACTERISTIQUES POUR LES TUYAUX
  331. *
  332.           ELSE IF (MFR.EQ.13) THEN
  333. *            pour les autres on ne ient pas compte des modification
  334. *            qui assouplissent le tuyau donc omega max diminue
  335.              NBROBL=NBROBL+2
  336.              SEGADJ NOMID
  337.              LESOBL(NBROBL-1)='EPAI'
  338.              LESOBL(NBROBL)='RAYO'
  339.           ELSE IF (MFR.EQ.39) THEN
  340.              NBROBL=NBROBL+2
  341.              NBRFAC=NBRFAC+2
  342.              SEGADJ NOMID
  343.              LESOBL(NBROBL-1)='EPAI'
  344.              LESOBL(NBROBL)='RAYO'
  345.              LESFAC(NBRFAC-1)='RACO'
  346.              LESFAC(NBRFAC)='PRES'
  347.           ENDIF
  348. *
  349.           MOMATR=NOMID
  350.           NMATR=NBROBL
  351.           NMATF=NBRFAC
  352. *
  353. * ===>
  354. *       write(6,*) 'Sous zone' ,isous,' Composante obligatoire ipche1'
  355. *       write(6,7001) (lesobl(i),i=1,nbrobl)
  356. *       write(6,*) 'facultatives'
  357. *       write(6,7001) (lesfac(i),i=1,nbrfac)
  358. *
  359.       ENDIF
  360. *
  361.       IF (NMATR.NE.0) THEN
  362.         CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAM1)
  363.         IF (MOTYPE.NE.MOTYR8) SEGSUP NOTYPE
  364.         nomid=momatr
  365.         if(lsupma)segsup NOMID
  366.         IF (IERR.NE.0) THEN
  367.             SEGSUP MCHELM
  368.             RETURN
  369.         ENDIF
  370. *           call tcloc2('Apres komcha2',6,it)
  371.       ENDIF
  372. *
  373. *--------------------------------------------------------------------*
  374. *       remplissage de la description du sous champ résultat
  375. *
  376. * dimension
  377. *    = 2 si taille et coque ou poutre
  378. *        mfr obtenu par elquoi nous renseigne
  379. *
  380.        IF ((ICAS.EQ.5).AND.
  381.      &    (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.7.OR.MFR.EQ.9.OR.MFR.EQ.13))
  382.      &    THEN
  383.           DEUCMP = .TRUE.
  384.           N2 = 2
  385.           SEGINI MCHAML
  386.           NOMCHE(1) = 'L'
  387.           NOMCHE(2) = 'L2H'
  388.           TYPCHE(1) = 'REAL*8'
  389.           TYPCHE(2) = 'REAL*8'
  390.        ELSE IF (ICAS.EQ.5) THEN
  391.           N2 = 1
  392.           SEGINI MCHAML
  393.           NOMCHE(1) = 'L'
  394.           TYPCHE(1) = 'REAL*8'
  395.        ELSE IF (ICAS.EQ.4) THEN
  396.           N2 = 1
  397.           SEGINI MCHAML
  398.           NOMCHE(1) = 'CSON'
  399.           TYPCHE(1) = 'REAL*8'
  400.        ELSE IF (ICAS.EQ.1.OR.ICAS.EQ.2.OR.ICAS.EQ.3) THEN
  401.           N2 = 1
  402.           SEGINI MCHAML
  403.           NOMCHE(1) = 'TCFL'
  404.           TYPCHE(1) = 'REAL*8'
  405.        ENDIF
  406.        ICHAML(ISOUS) = MCHAML
  407. *
  408. * le chamelem est defini au centre de gravité
  409. *
  410.         INFCHE(ISOUS,6) = 2
  411. * il faut brancher sur le segment d'intégration
  412.         INFCHE(ISOUS,4)=IPINT
  413. * nom du constituant
  414.         CONCHE(ISOUS) = CONMOD
  415. * maillage
  416.         IMACHE(ISOUS) = IPMAIL
  417. * a priori info ne set plus
  418. *        SEGSUP INFO
  419. *
  420. *--------------------------------------------------------------------*
  421. *       appel au sous routine spécifiques
  422. *
  423. *     NUMERO DES ETIQUETTES      :
  424. *     Les elements sont groupes comme suit :
  425. *      - massif,liquide 'surface libre' poreux ----------------------> 4
  426. *      - coq3,dkt,coq4,coq8,coq2,dst --------------------------------> 12
  427. *      - poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,jot3> 27
  428. *      - joi4,joi2,poutre de timoschenko,joi3                          29
  429. *
  430. *           1            5              0              5             0
  431.       GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,12,99, 4, 4, 4, 4,99,99,99,
  432.      2      99,99, 4, 4, 4, 4,27,27,29,99,99,99,99,99,99,99,99,99,99,99,
  433.      4      27,29,99,27,99,29,12,99,27,99,99,99,99,99,12,27,99,99,99,99,
  434.      6      99,99,99,99,99,99,99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,
  435.      8      99,99,99,29,99,99,99,99,99,99,99,99,27,12,99,99,99,99,99,99,
  436.      1      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  437.      2      99,99,99,99,99,99,99),MELE
  438.  99   CONTINUE
  439.       MOTERR(1:4)=NOMTP(MELE)
  440.       MOTERR(9:12)='CFL1'
  441.       CALL ERREUR(86)
  442.       SEGSUP MCHELM,MCHAML
  443.       RETURN
  444. C
  445. C_______________________________________________________________________
  446. C
  447. C     massif
  448. C_______________________________________________________________________
  449. C
  450.    4  CONTINUE
  451. *      write(6,*) 'Appel a cfl2'
  452.       CALL CFL2(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  453.       IF (IERR.NE.0) RETURN
  454.       GOTO 400
  455.  
  456. C_______________________________________________________________________
  457. C
  458. C     ELTS DE RACCORD LIQUIDE SOLIDE  RAC2 RACO LIA3 LIA4 LICO LIC4
  459. C          PAS DE RIGIDITE
  460. C_______________________________________________________________________
  461. C
  462.   12  CONTINUE
  463. *      write(6,*) 'Appel a cfl3'
  464.       CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  465.       IF (IERR.NE.0) RETURN
  466.       GOTO 400
  467. C_______________________________________________________________________
  468. C
  469. C     coq3,dkt,coq4,coq8,coq2,dst
  470. C_______________________________________________________________________
  471. C
  472.   27  CONTINUE
  473. *      write(6,*) 'Appel a cfl4'
  474.       CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  475.       IF (IERR.NE.0) RETURN
  476.       GOTO 400
  477. C_______________________________________________________________________
  478. C
  479. C poutre,barre,homogeneise
  480. C poutre de Timoschenko
  481. C_______________________________________________________________________
  482. C
  483.   29  CONTINUE
  484. *      write(6,*) 'Appel a cfl5'
  485. *  ivam1 et 2 sont actifs , ipmail descativé
  486.       CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  487. *  en sortie melv1 et melv2 sont inactifs
  488.       IF (IERR.NE.0) RETURN
  489.       GOTO 400
  490. *
  491.  400  CONTINUE
  492. *  on raccroche le résultat
  493.       IELVAL(1) = MELV1
  494.       IF (DEUCMP)  IELVAL(2) = MELV2
  495.       SEGDES MCHAML
  496.       SEGDES IMODEL
  497.       IF (IVAM1.NE.0) THEN
  498.          MPTVAL = IVAM1
  499.          SEGSUP MPTVAL
  500.       ENDIF
  501.       IF (IVAM2.NE.0) THEN
  502.          MPTVAL = IVAM2
  503.          SEGSUP MPTVAL
  504.       ENDIF
  505. * fin boucle sur les sous zone des champs
  506.  500  CONTINUE
  507. *
  508.        IPCHA4 = MCHELM
  509.        SEGDES MCHELM,MMODEL
  510.  
  511.        RETURN
  512.        END
  513.  
  514.  
  515.  

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