Esope source files

   1 : C COMTRI    SOURCE    FANDEUR   12/07/18    21:15:33     7435           
   2 :       SUBROUTINE COMTRI(iqmod,ipil,iwrk53)
   3 : *--------------------------
   4 : * verification de type des composantes
   5 : *  attention revoir noms de caracteristiques geometriques / idcarb
   6 : *--------------------------
   7 :       IMPLICIT INTEGER(I-N)
   8 :       IMPLICIT REAL*8(A-H,O-Z)
   9 : *
  10 : -INC CCOPTIO
  11 : *
  12 : -INC SMMODEL
  13 : -INC DECHE
  14 : *
  15 :       imodel = iqmod
  16 :       wrk53 = iwrk53
  17 :       liluc = ipil
  18 : 
  19 :       ijluc = MIN(liluc(/1),nmot)
  20 : 
  21 :       do ino = 1, ijluc
  22 :         domdec = liluc(ino)
  23 : c*        segact domdec*nomod
  24 :         nomid = jnomid
  25 : c*        segact nomid*nomod
  26 :         nobl = lesobl(/2)
  27 :         nfac = lesfac(/2)
  28 : c*        write(ioimp,*) 'comtri ',mfr,inplas,nobl,nfac
  28 :         call cotype(iqmod,ino,motype,iwrk53,nobl,nfac)
  29 :         notype = motype
  30 :         if (notype.eq.0) goto 100
  31 :         nbtype = type(/2)
  32 :         if (nbtype.eq.0) goto 101
  33 : *
  34 :         pilnec = jilnec
  35 : c*        segact pilnec*nomod
  36 : c*        mobl = pilobl(/1) = nobl
  37 : c*        mfac = pilfac(/1) = nfac
  38 :         mran = pilobl(/2)
  39 :         if (nobl.gt.0) then
  40 :           do iran = 1, mran
  41 :             do ic1 = 1, nobl
  42 :               deche = pilobl(ic1,iran)
  43 :               if (deche.gt.0) then
  44 : ******            segact deche
  45 : c          write(6,*) 'comtri deche ',deche,nomdec,typdec,iran,cmate
  46 :                 ICMN = MIN(IC1,NBTYPE)
  47 : *           write(6,*) 'comtri '  , ic1,iran,LESOBL(IC1)(1:4), notype   
  48 :                 if (typdec.ne.type(icmn)) then
  49 :                   MOTERR(1:16)=typdec     
  50 :                   MOTERR(17:20)=nomdec   
  51 :                   MOTERR(21:36)=' utile '          
  51 :                   CALL ERREUR(552)
  52 :                   return
  53 :                 endif   
  54 :               endif
  55 :             enddo   
  56 :           enddo   
  57 :         endif   
  58 :         if (nfac.gt.0) then
  59 :           do iran = 1, mran
  60 :             do ic1 = 1,nfac
  61 :               deche = pilfac(ic1,iran)
  62 :               if (deche.gt.0) then
  63 : ******            segact deche
  64 :                 ICMN=MIN((IC1+nobl),NBTYPE)
  65 : c       write(6,*) 'comtrifac',deche,nomdec,typdec,iran,nbtype,type(icmn)
  66 :                 if (typdec.ne.type(icmn)) then
  67 :                   MOTERR(1:16)=typdec  
  68 :                   MOTERR(17:20)=nomdec    
  69 :                   MOTERR(21:36)=' utile '          
  69 :                   CALL ERREUR(552)
  70 :                   return
  71 :                 endif   
  72 :               endif
  73 :             enddo
  74 :           enddo  
  75 :         endif  
  76 :  101    continue
  77 :         segsup notype
  78 :  100    continue
  79 :       enddo
  80 : *
  81 :       RETURN
  82 :       END 
  83 : 
  84 :