Télécharger la plaquette Cast3M


fr en

Télécharger cotemo.eso

Retour à la liste

Numérotation des lignes : 

cotemo

  1. C COTEMO    SOURCE    OF166741  24/10/07    21:15:10     12016          
  2.  
  3. c-----------------------------------------------------------------------
  4. c
  5. c teste les noms des composantes des MCHAML susceptibles d etre crees
  6. c avec le sous model : on ne veut pas de redondance
  7. C sauf pour les formulations  CHARGEMENT CONTRAINTE
  8. c
  9. c-----------------------------------------------------------------------
  10.       SUBROUTINE COTEMO(IP1,MFR)
  11.  
  12.       IMPLICIT INTEGER(I-N)
  13.       IMPLICIT REAL*8 (A-H,O-Z)
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17.  
  18. -INC SMMODEL
  19.  
  20.       SEGMENT nomlis
  21.         CHARACTER*(LOCOMP) lescom(NTOT)
  22.         CHARACTER*(8)      lecham(NTOT)
  23.       ENDSEGMENT
  24.  
  25.       CHARACTER*(LOCOMP) moref
  26.       CHARACTER*(8)      mocham
  27.  
  28.       imodel = IP1
  29.       NFOR = imodel.formod(/2)
  30.  
  31. C* Cas particuliers :
  32.       CALL PLACE(FORMOD,NFOR,icont,'CONTRAINTE      ')
  33.       CALL PLACE(FORMOD,NFOR,ichgt,'CHARGEMENT      ')
  34.       i_z = icont + ichgt
  35.       IF (i_z.GT.0) RETURN
  36.  
  37.       CALL PLACE(FORMOD,NFOR,imagn,'MAGNETODYNAMIQUE')
  38. c*      CALL PLACE(FORMOD,NFOR,idiff,'DIFFUSION       ')
  39. c*      CALL PLACE(FORMOD,NFOR,ielec,'ELECTROSTATIQUE ')
  40.       CALL PLACE(FORMOD,NFOR,ither,'THERMIQUE       ')
  41.       CALL PLACE(FORMOD,NFOR,ithhy,'THERMOHYDRIQUE  ')
  42.       ithe = ither + ithhy
  43.  
  44.       ntot = 0
  45.       SEGINI,nomlis
  46.  
  47.       DO lm = 1, 22
  48.  
  49.         NBROBL = 0
  50.         NBRFAC = 0
  51.         NOMID  = 0
  52.         mocham = '        '
  53.  
  54.         goto (  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13,
  55.      &         14, 15, 16, 17, 18, 19, 20, 21, 22) lm
  56.  
  57.    1    continue
  58.         NBROBL=1
  59.         SEGINI NOMID
  60.         LESOBL(1)='SCAL    '
  61.         mocham = 'RESERVE '
  62.         GOTO 120
  63.  
  64.    2    continue
  65.         NBROBL=1
  66.         SEGINI NOMID
  67.         LESOBL(1)='MAHO    '
  68.         mocham = 'MAHOOKE '
  69.         GOTO 120
  70.  
  71.    3    continue
  72.         NBROBL=1
  73.         SEGINI NOMID
  74.         LESOBL(1)='TEMP    '
  75.         mocham = 'RESERVE '
  76.         GOTO 120
  77.  
  78.    4    continue
  79.         GOTO 120
  80.  
  81.    5    continue
  82.         GOTO 120
  83.  
  84.    6    continue
  85.         nomid = lnomid(1)
  86.         if (nomid.eq.0) then
  87. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(1)'
  88.           CALL IDPRIM(IMODEL,MFR,NOMID,NBROBL,NBRFAC)
  89.         endif
  90.         mocham = 'DEPLACEM'
  91.         GOTO 120
  92.  
  93.    7    continue
  94.         nomid = lnomid(2)
  95.         if (nomid.eq.0) then
  96. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(2)'
  97.           CALL IDDUAL(IMODEL,MFR,NOMID,NBROBL,NBRFAC)
  98.         endif
  99.         mocham = 'FORCES  '
  100.         GOTO 120
  101.  
  102.    8    continue
  103.         GOTO 120
  104.  
  105.    9    continue
  106.         GOTO 120
  107.  
  108.   10    continue
  109.         nomid = lnomid(3)
  110.         if (nomid.eq.0) then
  111. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(3)'
  112.           CALL IDGRAD(MFR,IFOUR,NOMID,NBROBL,NBRFAC)
  113.         endif
  114.         mocham = 'GRADIENT'
  115.         GOTO 120
  116.  
  117.   11    continue
  118.         nomid = lnomid(4)
  119.         if (nomid.eq.0) then
  120. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(4)'
  121.           CALL IDCONT(IMODEL,IFOUR,NOMID,NBROBL,NBRFAC)
  122.         endif
  123.         mocham = 'CONTRAIN'
  124.         GOTO 120
  125.  
  126.   12    continue
  127.         nomid = lnomid(5)
  128.         if (nomid.eq.0) then
  129. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(5)'
  130.           CALL IDDEFO(IMODEL,IFOUR,NOMID,NBROBL,NBRFAC)
  131.         endif
  132.         mocham = 'DEFORMAT'
  133.         GOTO 120
  134.  
  135.   13    continue
  136.         nomid = lnomid(6)
  137.         if (nomid.eq.0) then
  138. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(6)'
  139.           CALL IDMATR(MFR,IMODEL,NOMID,NBROBL,NBRFAC)
  140.         endif
  141.         mocham = 'MATERIAU'
  142.         GOTO 120
  143.  
  144.   14    continue
  145.         nomid = lnomid(7)
  146.         if (nomid.eq.0) then
  147. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(7)'
  148.           MELE = imodel.nefmod
  149.           CALL IDCARB(MELE,IFOUR,NOMID,NBROBL,NBRFAC)
  150.         endif
  151.         mocham = 'CARACTER'
  152.         GOTO 120
  153.  
  154.   15    continue
  155.         nomid = lnomid(8)
  156.         if (nomid.eq.0) then
  157. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(8)'
  158.           NPINT = 0
  159.           CALL IDTEMP(MFR,IFOUR,NPINT,NOMID,NBROBL,NBRFAC)
  160.         endif
  161.         mocham = 'TEMPERAT'
  162.         GOTO 120
  163.  
  164.   16    continue
  165.         nomid = lnomid(9)
  166.         if (nomid.eq.0) then
  167. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(9)'
  168.           CALL IDPRIN(MFR,IFOUR,NOMID,NBROBL,NBRFAC)
  169.         endif
  170.         mocham = 'PRINCIPA'
  171.         GOTO 120
  172.  
  173.   17    continue
  174.         nomid = lnomid(13)
  175.         if (nomid.eq.0) then
  176. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(13)'
  177.           CALL IDDEIN(IMODEL,IFOUR,NOMID,NBROBL,NBRFAC)
  178.         endif
  179.         mocham = 'DEFINELA'
  180.         GOTO 120
  181.  
  182.   18    continue
  183.         GOTO 120
  184.  
  185.   19    continue
  186.         GOTO 120
  187.  
  188.   20    continue
  189.         nomid = lnomid(10)
  190.         if (nomid.eq.0) then
  191. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(10)'
  192.           CALL IDVARI(MFR,IMODEL,NOMID,NBROBL,NBRFAC)
  193.         endif
  194.         mocham = 'VARINTER'
  195.         GOTO 120
  196.  
  197.   21    continue
  198.         nomid = lnomid(11)
  199.         if (nomid.eq.0) then
  200. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(11)'
  201.           CALL IDGRAF(MFR,IFOUR,NOMID,NBROBL,NBRFAC)
  202.         endif
  203.         mocham = 'GRAFLEXI'
  204.         GOTO 120
  205.  
  206.   22    continue
  207.         nomid = lnomid(12)
  208.         if (nomid.eq.0) then
  209. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(12)'
  210.           CALL IDPHAS(MFR,IMODEL,NOMID,NBROBL,NBRFAC)
  211.         endif
  212.         mocham = 'PHASES  '
  213.         GOTO 120
  214.  
  215.  120    continue
  216.         if (nomid.gt.0) then
  217.           nbrcom = nbrobl + nbrfac
  218.           nto1 = lescom(/2)
  219.           ntot = nto1 + nbrcom
  220.           SEGADJ,nomlis
  221.           do im = 1, nbrcom
  222.             lecham(nto1 + im) = mocham
  223.             if (im.le.nbrobl) then
  224.               lescom(nto1 + im) = lesobl(im)
  225.             else
  226.               lescom(nto1 + im) = lesfac(im - nbrobl)
  227.             endif
  228.           enddo
  229. *          write(6,*) 'lm ', lm, mocham, nobl, nfac,'nto1 ', nto1,MFR
  230.         endif
  231.  
  232.       ENDDO
  233.  
  234.       ntot = lescom(/2)
  235.       DO im = 1, (ntot - 1)
  236.         moref  = lescom(im)
  237. *        write(6,*) 'comp-champ-ref',im,moref,lecham(im)
  238.         if (moref.eq.'T       ') goto 800
  239.         if (moref.eq.'EPAI    '.and.imagn.ne.0) goto 800
  240.         if ((moref.eq.'QSUP    '.or.moref.eq.'QINF    ').and.
  241.      &      ithe.ne.0) goto 800
  242.         DO jm = (im + 1), ntot
  243. *          write(6,*) 'comp-champ-tes',jm,lescom(jm),lecham(jm)
  244.           if (lescom(jm).eq.moref) then
  245.             moterr(1:8)   = moref
  246.             moterr(9:16)  = lecham(im)
  247.             moterr(17:24) = lecham(jm)
  248.             call erreur(913)
  249.           endif
  250.         ENDDO
  251.  800    continue
  252.       ENDDO
  253.  
  254.       SEGSUP,nomlis
  255.  
  256. c      return
  257.       end
  258.  
  259.  
  260.  

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