Télécharger la plaquette Cast3M


fr en

Télécharger zpmode.eso

Retour à la liste

Numérotation des lignes : 

zpmode

  1. C ZPMODE    SOURCE    CB215821  24/04/12    21:17:33     11897          
  2.  
  3. *---------------------------------------
  4. *      ECRITURE D'UN OBJET MODELE
  5. *---------------------------------------
  6.  
  7.       SUBROUTINE ZPMODE (MMODEL)
  8.  
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8 (A-H,O-Z)
  11.  
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC CCHAMP
  16.  
  17. -INC SMMODEL
  18. -INC SMLMOTS
  19.  
  20.        EXTERNAL LONG
  21.  
  22.        character*16 mderiv(6)
  23.        character*6 cha6Fa,cha6Fb
  24.        character*8 nomtyp(19),MOT8
  25.        character*(LOCHAI) motlib,fmt1
  26.        character*12 MNLOCA(3)
  27.        logical b_z
  28.  
  29.        DATA MDERIV/'Lineaire        ','Quadratique     ',
  30.      $  'TRUSDELL        ','JAUMANN         ','Utilisateur     ',
  31.      $  'FEFP            '/
  32.        data nomtyp/
  33.      1              'INCOPRIM', 'INCODUAL', 'GRADIENT', 'CONTRAIN',
  34.      1              'DEFORMAT', 'MATERIAU', 'CARACTER', 'TEMPERAT',
  35.      1              'PRINCIPA', 'VARINTER', 'GRAFLEXI', 'PHASES  ',
  36.      1              'DEFINELA', 'PARAMEXT', '        ', 'SCAL    ',
  37.      1              'TEMP    ', 'MAHO    ', 'MAHT    '/
  38.       DATA MNLOCA /'Moyenne     ','Stress based','HELMHOLTZ   '/
  39.       SEGACT,MMODEL
  40.       N1=KMODEL(/1)
  41.  
  42.       WRITE(IOIMP,190)
  43.       WRITE(IOIMP,200)
  44.       WRITE(IOIMP,201)
  45.       WRITE(IOIMP,210) N1,MMODEL
  46.       WRITE(IOIMP,201)
  47.       WRITE(IOIMP,200)
  48.  
  49.       DO N=1,N1
  50.         IMODEL=KMODEL(N)
  51.         SEGACT,IMODEL
  52.         WRITE(IOIMP,2) N,IMODEL
  53.         WRITE(IOIMP,3) IMAMOD,NOMTP(NEFMOD)
  54.         IF (CONMOD.NE.'                ') WRITE(IOIMP,4)CONMOD
  55.         IF (conmod(17:24).NE.'        ') WRITE(IOIMP,8) conmod(17:24)
  56.  
  57.         nfor   = formod(/2)
  58.         NMAT   = MATMOD(/2)
  59.         nobmod = tymode(/2)
  60.         mn3    = infmod(/1)
  61.         if(mn3.ge.13) then
  62.           inloc = -1*infmod(13)
  63.           lulvia= infmod(14)
  64.         else
  65.           inloc = 0
  66.           lulvia= 0
  67.         endif
  68.  
  69.         WRITE(IOIMP,5) (FORMOD(i),i=1,NFOR)
  70.         IIPDPG = imodel.IPDPGE
  71.         IF (IIPDPG.NE.0) WRITE(IOIMP,7) IPTPOI(IIPDPG),IIPDPG
  72.         IF (NMAT.NE.0) WRITE(IOIMP,6) (MATMOD(i),i=1,NMAT)
  73.         mecfor=0
  74.         mdifor = 0
  75.         do i=1,nfor
  76.           if(formod(i).eq.'MECANIQUE'.or.formod(i).eq.'POREUX'.or.
  77.      & formod(i).eq.'NAVIER_STOKES') mecfor=1
  78.           if(formod(i).eq.'DIFFUSION') mdifor=1
  79.         enddo
  80.         if(mecfor.eq.1) then
  81. c            write(ioimp,27) mderiv(ideriv)
  82. cbp,2020-12-10 : abandon de IDERIV (MMODEL)
  83.            if(inloc.ne.0) then
  84.              write(ioimp,28) mnloca(inloc)
  85.              if(lulvia.ne.0) then
  86.                mlmots=lulvia
  87.                segact,mlmots
  88.                write(ioimp,29) (mots(iu),iu=1,mots(/2))
  89.              endif
  90.            endif
  91.  
  92.         endif
  93.         do io=1,19
  94.           nomid = lnomid(io)
  95.           if(nomid.gt.0) then
  96. C         write(6,*) 'nomid',io,nomid
  97.              segact nomid
  98.              if(lesobl(/2).ne.0) then
  99.                write(ioimp,20) nomtyp(io),nomid
  100.           if(lesobl(/2).NE.0)write(ioimp,21)(lesobl(iu),iu=1,lesobl(/2))
  101.           if(lesfac(/2).NE.0)write(ioimp,21)(lesfac(iu),iu=1,lesfac(/2))
  102.              endif
  103.           endif
  104.         enddo
  105.  
  106.          write(ioimp,23)(infele(iu),iu=1,6),infele(13),infele(14)
  107.  
  108. c*        if (inatuu.ne.0 .or. imatee.ne.0) then
  109.         if (imatee.ne.0) then
  110.           write(ioimp,22) cmatee, imatee, inatuu
  111.           if (inatuu.eq.-1) then
  112.             write(ioimp,221) matmod(nmat)
  113.           endif
  114.           if (inatuu.eq.-2) then
  115.             iviex = 0
  116.             CALL PLACE(tymode,nobmod,iviex,'IVIEX   ')
  117.             write(ioimp,222) ivamod(iviex)
  118.           endif
  119.         endif
  120.  
  121. *       Impression du contenu de TYMODE et IVAMOD
  122.         cha6Fa(1:4)='(I )'
  123.         cha6Fb(1:2)='(A'
  124.         DO i=1,nobmod          
  125.           IF (i.EQ.1)WRITE(IOIMP,12)
  126.           MOT8=TYMODE(i)
  127.           IVA =IVAMOD(I)
  128.           IF    (MOT8 .EQ. 'MOT     ')THEN
  129.             CALL QUEVAL(IVA,'MOT     ',ier,lgmot,r_z, motlib,b_z,i_z)
  130.             IF(IER .NE. 0)CALL ERREUR(5)
  131.  
  132. C           Determination du FORMAT automatique
  133.             IFORMA = INT(LOG10(REAL(lgmot))) + 1
  134.             IF    (IFORMA.GE.1 .AND. IFORMA.LT.9 )THEN
  135.               WRITE(cha6Fa(3:3), '(I1)') IFORMA
  136.             ELSE
  137.               CALL ERREUR(5)
  138.             ENDIF
  139.  
  140.  
  141.             WRITE(cha6Fb(3:3+IFORMA-1),FMT=cha6Fa) lgmot
  142.             cha6Fb(3+IFORMA:3+IFORMA)=')'
  143.  
  144.             fmt1='(11X,A8,2X,'//cha6Fb(2:3+IFORMA-1)//')'
  145.             WRITE(IOIMP,FMT=fmt1) MOT8,motlib(1:MIN(lgmot,72))
  146.           ELSE
  147.             WRITE(IOIMP,13) MOT8,IVA
  148.           ENDIF
  149.         ENDDO
  150.  
  151. *       if (infmod(/1).gt.2)  write(IOIMP,*)
  152. *     $ 'segment d integtration ',(infmod(iu),iu=3,infmod(/1))
  153.  
  154.         IF (nobmod.NE.0) THEN
  155.           if ((mecfor.eq.1 .and. inatuu.lt.0) .or. mdifor.eq.1) then
  156.  
  157.  
  158.             noblib = 0
  159.             if (mdifor.eq.1) then
  160.               CALL PLACE(tymode,nobmod,noblib,'LDIEXT  ')
  161.             else
  162.               CALL PLACE(tymode,nobmod,noblib,'LMEEXT  ')
  163.             endif
  164.             if (noblib.gt.0) then
  165.               iva=ivamod(noblib+1)
  166.               call queval(iva,'MOT     ',ier,lgmot,r_z, motlib,b_z,i_z)
  167.               lglib = INDEX(motlib,'=')-1
  168.               m_libe = LONG(motlib(1:lglib))
  169.               if (m_libe.gt.72) then
  170.                 write(ioimp,223) motlib(1:72)//'...'
  171.               else
  172.                 write(ioimp,223) motlib(1:m_libe)
  173.               endif
  174.               m_mode = LONG(motlib(lglib+2:lgmot))
  175.               write(ioimp,224) motlib(lglib+2:lglib+m_mode+1)
  176.             endif
  177.           else
  178. C            WRITE(IOIMP,12) (TYMODE(i),IVAMOD(i),i=1,nobmod)
  179.           endif
  180.         ENDIF
  181.       ENDDO
  182.  
  183.       WRITE(IOIMP,190)
  184.  
  185.  190  FORMAT(//)
  186.  200  FORMAT(1X,'+',77('-'),'+')
  187.  201  FORMAT(1X,'|',T80,'|')
  188.  210  FORMAT(' |          OBJET  MMODEL  CONTENANT ',I6,
  189.      .       ' ZONE(S) ELEMENTAIRE(S)',I10,T80,'|')
  190.  2    FORMAT(//10X,' ZONE ELEMENTAIRE NUMERO ',I6,' : IMO',I10,
  191.      .        /10X,' -----------------------------------------------')
  192.  3    FORMAT(/1X,'  POINTEUR SUR L''OBJET MAILLAGE : ',I10,/,
  193.      .        1X,'  TYPE D''ELEMENT FINI  :  ',3X,A4)
  194.  4    FORMAT(1X,'  NOM DU CONSTITUANT   :  ',3X,A24)
  195.  5    FORMAT(1X,'  FORMULATION          :  ',5(3X,A16))
  196.  6    FORMAT(1X,'  MODELE DE MATERIAU   :  ',5(3X,A16))
  197.  7    FORMAT(1X,'  POINT SUPPORT DPGE   :  ',I10,/,
  198.      $       1X,'  stocke dans le maillage de pointeur', I10)
  199.  8    FORMAT(1X,'  NOM DE LA PHASE      :  ',3X,A8)
  200.  9    FORMAT(1X,'  VARIABLES INTERNES   :    ',12(1X,A4))
  201.  10   FORMAT(1X,'  PARAMETRES MATERIAUX :    ',12(1X,A4))
  202.  12   FORMAT(/'   Liste des objets associes : type - valeur')
  203.  13   FORMAT(11X,A8,2X,I10,10X)
  204.  14   FORMAT(11X,A8,2X,A72)
  205.  20   FORMAT(1x,'  Liste des noms de composantes de ',a8, 
  206.      &          '    -    Pointeur nomid:',I10)
  207.  21   format (10x, 16(A4,1X))
  208.  22   format(1x,'  MATERIAU cmate imate inatu   : ',a8,2I5)
  209.  221  format(9x,'  NOM LOI UTILISATEUR : "',a16,'"')
  210.  222  format(9x,'  LOI VISCO_EXTERNE   : ',I5)
  211.  223  format(9x,'  "LIBRAIRIE" EXTERNE : "',A,'"')
  212.  224  format(9x,'  "FONCTION" EXTERNE  : "',A,'"')
  213.  
  214.  23   format(/1X,'  numero de l element fini (nefmod):' , i5,/,
  215.      $       1X,'  points integration epaisseur     :' , i5,/,
  216.      $       1X,'  points de gauss pour masse       :' , i5,/,
  217.      $       1X,'  points support de contraintes    :' , i5,/,
  218.      $       1X,'  nombre de caracteristiques       :' , i5,/,
  219.      $       1X,'  points de gauss pour rigidite    :' , i5,/,
  220.      $       1X,'  numero de la formulation E.F(mfr):' , i5,/,
  221.      $       1X,'  numero de  l element geometrique :' , i5)
  222.  27   format(1x,'  Hypothese de deformations : ',a16,/)
  223.  28   format(1x,'  Formulation non locale    : ',a12)
  224.  29   format(1x,'  Variables moyennees       :',12(1X,A4))
  225.  
  226.       RETURN
  227.       END
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  

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