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    MB234859  25/08/04    21:15:02     12339          
  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(IMODEL,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.           CALL IDTEMP(IMODEL,IFOUR,NOMID,NBROBL,NBRFAC)
  159.         endif
  160.         mocham = 'TEMPERAT'
  161.         GOTO 120
  162.  
  163.   16    continue
  164.         nomid = lnomid(9)
  165.         if (nomid.eq.0) then
  166. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(9)'
  167.           CALL IDPRIN(IMODEL,IFOUR,NOMID,NBROBL,NBRFAC)
  168.         endif
  169.         mocham = 'PRINCIPA'
  170.         GOTO 120
  171.  
  172.   17    continue
  173.         nomid = lnomid(13)
  174.         if (nomid.eq.0) then
  175. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(13)'
  176.           CALL IDDEIN(IMODEL,IFOUR,NOMID,NBROBL,NBRFAC)
  177.         endif
  178.         mocham = 'DEFINELA'
  179.         GOTO 120
  180.  
  181.   18    continue
  182.         GOTO 120
  183.  
  184.   19    continue
  185.         GOTO 120
  186.  
  187.   20    continue
  188.         nomid = lnomid(10)
  189.         if (nomid.eq.0) then
  190. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(10)'
  191.           CALL IDVARI(MFR,IMODEL,NOMID,NBROBL,NBRFAC)
  192.         endif
  193.         mocham = 'VARINTER'
  194.         GOTO 120
  195.  
  196.   21    continue
  197.         nomid = lnomid(11)
  198.         if (nomid.eq.0) then
  199. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(11)'
  200.           CALL IDGRAF(IMODEL,IFOUR,NOMID,NBROBL,NBRFAC)
  201.         endif
  202.         mocham = 'GRAFLEXI'
  203.         GOTO 120
  204.  
  205.   22    continue
  206.         nomid = lnomid(12)
  207.         if (nomid.eq.0) then
  208. c*      write(ioimp,*) 'COTEMO : NOMID = 0 = lnomid(12)'
  209.           CALL IDPHAS(MFR,IMODEL,NOMID,NBROBL,NBRFAC)
  210.         endif
  211.         mocham = 'PHASES  '
  212.         GOTO 120
  213.  
  214.  120    continue
  215.         if (nomid.gt.0) then
  216.           nbrcom = nbrobl + nbrfac
  217.           nto1 = lescom(/2)
  218.           ntot = nto1 + nbrcom
  219.           SEGADJ,nomlis
  220.           do im = 1, nbrcom
  221.             lecham(nto1 + im) = mocham
  222.             if (im.le.nbrobl) then
  223.               lescom(nto1 + im) = lesobl(im)
  224.             else
  225.               lescom(nto1 + im) = lesfac(im - nbrobl)
  226.             endif
  227.           enddo
  228. *          write(6,*) 'lm ', lm, mocham, nobl, nfac,'nto1 ', nto1,MFR
  229.         endif
  230.  
  231.       ENDDO
  232.  
  233.       ntot = lescom(/2)
  234.       DO im = 1, (ntot - 1)
  235.         moref  = lescom(im)
  236. *        write(6,*) 'comp-champ-ref',im,moref,lecham(im)
  237.         if (moref.eq.'T       ') goto 800
  238.         if (moref.eq.'EPAI    '.and.imagn.ne.0) goto 800
  239.         if ((moref.eq.'QSUP    '.or.moref.eq.'QINF    ').and.
  240.      &      ithe.ne.0) goto 800
  241.         DO jm = (im + 1), ntot
  242. *          write(6,*) 'comp-champ-tes',jm,lescom(jm),lecham(jm)
  243.           if (lescom(jm).eq.moref) then
  244.             moterr(1:8)   = moref
  245.             moterr(9:16)  = lecham(im)
  246.             moterr(17:24) = lecham(jm)
  247.             call erreur(913)
  248.           endif
  249.         ENDDO
  250.  800    continue
  251.       ENDDO
  252.  
  253.       SEGSUP,nomlis
  254.  
  255. c      return
  256.       end
  257.  
  258.  
  259.  
  260.  

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