Télécharger cotemo.eso

Retour à la liste

cotemo
C COTEMO    SOURCE    CB215821  24/04/12    21:15:30     11897          
      SUBROUTINE COTEMO(IP1,MFR)
c-----------------------------------------------------------------------
c
c teste les noms des composantes des MCHAML susceptibles d etre crees
c avec le sous model : on ne veut pas de redondance
c
c-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMMODEL
      pointeur nomid1.nomid
      segment NOMLIS
        CHARACTER*8 LESCOM(NTOT)
        CHARACTER*8 lecham(ntot)
      endsegment
*
      character*8 mocham, moref
 
      imodel = ip1
      ntot = 0
      segini nomlis
      nfor=formod(/2)
      ithe=0
      CALL PLACE(FORMOD,NFOR,IMAGN,'MAGNETODYNAMIQUE')
      CALL PLACE(FORMOD,NFOR,IDIFF,'DIFFUSION')
      CALL PLACE(FORMOD,NFOR,IELEC,'ELECTROSTATIQUE')
      CALL PLACE(FORMOD,NFOR,ITHEHY,'THERMOHYDRIQUE')
      CALL PLACE(FORMOD,NFOR,IRAYO,'RAYONNEMENT')
      CALL PLACE(FORMOD,NFOR,ICONV,'CONVECTION')
      CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE')
      ithe=ithehy+iconv+ither+irayo
 
      do lm = 1,22
 
        MOCOMP=0
        mocham = '        '
 
        goto (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
     & 16, 17, 18, 19, 20, 21, 22) lm
 
   1    NBROBL=1
        NBRFAC=0
        SEGINI NOMID
        LESOBL(1)='SCAL    '
        MOCOMP=NOMID
        mocham = 'RESERVE '
        GOTO 120
*
   2    NBROBL=1
        NBRFAC=0
        SEGINI NOMID
        LESOBL(1)='MAHO    '
        MOCOMP=NOMID
        mocham = 'MAHOOKE '
        GOTO 120
*
   3    NBROBL=1
        NBRFAC=0
        SEGINI NOMID
        LESOBL(1)='TEMP    '
        MOCOMP=NOMID
        mocham = 'RESERVE '
        GOTO 120
*
   4    continue
        GOTO 120
 
   5    continue
        GOTO 120
*
   6    CALL IDPRIM(IMODEL,MFR,MOCOMP,NOBL,NFAC)
        mocham = 'DEPLACEM'
        GOTO 120
*
   7    CALL IDDUAL(IMODEL,MFR,MOCOMP,NOBL,NFAC)
        mocham = 'FORCES  '
        GOTO 120
*
   8    continue
        GOTO 120
 
   9    continue
        GOTO 120
*
  10   continue
         if(lnomid(3).ne.0) then
          mocomp=lnomid(3)
         else
          CALL IDGRAD(MFR,IFOUR,MOCOMP,NOBL,NFAC)
         endif
         mocham = 'GRADIENT'
         GOTO 120
*
  11   if(lnomid(4).ne.0) then
         mocomp=lnomid(4)
        else
         CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'CONTRAIN'
        GOTO 120
*
  12    if(lnomid(5).ne.0) then
         mocomp=lnomid(5)
        else
         CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'DEFORMAT'
        GOTO 120
*
  13    if(lnomid(6).ne.0) then
         mocomp=lnomid(6)
        else
         CALL IDMATR(MFR,IMODEL,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'MATERIAU'
        GOTO 120
*
  14    if(lnomid(7).ne.0) then
         mocomp=lnomid(7)
        else
         CALL IDCARB(MELE,IFOUR,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'CARACTER'
        GOTO 120
*
  15    if(lnomid(8).ne.0) then
         mocomp=lnomid(8)
        else
         CALL IDTEMP(MFR,IFOUR,NPINT,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'TEMPERAT'
        GOTO 120
*
  16    if(lnomid(9).ne.0) then
          mocomp=lnomid(9)
        else
          CALL IDPRIN(MFR,IFOUR,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'PRINCIPA'
        GOTO 120
*
  17    if(lnomid(13).ne.0) then
          mocomp=lnomid(13)
        else
          CALL IDDEIN(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'DEFINELA'
        GOTO 120
*
  18    continue
  19    continue
        GOTO 120
*
  20    if(lnomid(10).ne.0) then
         mocomp=lnomid(10)
       else
        CALL IDVARI(MFR,IMODEL,MOCOMP,NOBL,NFAC)
       endif
        mocham = 'VARINTER'
        GOTO 120
*
  21    if(lnomid(11).ne.0) then
         mocomp=lnomid(11)
       else
         CALL IDGRAF(MFR,IFOUR,MOCOMP,NOBL,NFAC)
       endif
        mocham = 'GRAFLEXI'
        GOTO 120
*
  22  if(lnomid(12).ne.0) then
         mocomp=lnomid(12)
       else
        CALL IDPHAS(MFR,IMODEL,MOCOMP,NOBL,NFAC)
       endif
        mocham = 'PHASES  '
        GOTO 120
*
 120    CONTINUE
        nomid = mocomp
        if (nomid.gt.0) then
C        CB215821 : Il reste encore plein de SEGDES, NOMID dans les id___.eso ==> on laisse segact ici
         segact,nomid
         nobl = lesobl(/2)
         nfac = lesfac(/2)
         nto1 = lescom(/2)
         ntot = nto1 + nobl + nfac
*        write(6,*) 'lm ', lm, mocham, nobl, nfac,'nto1 ', nto1,mfr
         segadj nomlis
        do im = 1,(nobl+nfac)
         lecham(nto1 + im) = mocham
         if (im.le.nobl) then
           lescom(nto1 + im) = lesobl(im)
         else
           lescom(nto1 + im) = lesfac(im - nobl)
         endif
        enddo
       endif
      enddo
*
      ntot = lescom(/2)
*      write(6,*) 'ntot -cotemo', ntot
      do 874 in = 1, (ntot - 1)
        moref = lescom(in)
        mocham = lecham(in)
*        write(6,*) 'comp-champ-ref' , in ,moref, mocham
        do jm = (in + 1),ntot
*        write(6,*) 'comp-champ-tes' , jm, lescom(jm), lecham(jm)
         if (lescom(jm).eq.moref)  then
         if (moref.eq.'EPAI'.and.imagn.ne.0)           go to 874
         if((moref.eq.'QSUP'.or. moref.eq.'QINF').and.
     &                                      ithe.ne.0) go to 874
           if(moref.eq.'T   ') go to 874
           moterr(1:8)   = moref
           moterr(9:16)  = lecham(in)
           moterr(17:24) = lecham(jm)
           call erreur(913)
         endif
        enddo
 874  continue
 
      segsup nomlis
      return
      end
 
 
 

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