Télécharger la plaquette Cast3M


fr en

Télécharger comtri.eso

Retour à la liste

Numérotation des lignes : 

comtri

  1. C COMTRI    SOURCE    PV        17/12/08    21:16:53     9660           
  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.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. *
  14. -INC SMMODEL
  15. -INC DECHE
  16. *
  17.       imodel = iqmod
  18.       wrk53 = iwrk53
  19.       liluc = ipil
  20.  
  21.       ijluc = MIN(liluc(/1),nmot)
  22.  
  23.       do ino = 1, ijluc
  24.         nomid = liluc(ino,1)
  25. c*        segact nomid*nomod
  26.         nobl = lesobl(/2)
  27.         nfac = lesfac(/2)
  28. c*        write(ioimp,*) 'comtri ',mfr,inplas,nobl,nfac
  29.         call cotype(iqmod,ino,motype,iwrk53,nobl,nfac)
  30.         notype = motype
  31.         if (notype.eq.0) goto 100
  32.         nbtype = type(/2)
  33.         if (nbtype.eq.0) goto 101
  34. *
  35.         pilnec = liluc(ino,2)
  36. c*        segact pilnec*nomod
  37. c*        mobl = pilobl(/1) = nobl
  38. c*        mfac = pilfac(/1) = nfac
  39.         mran = pilobl(/2)
  40.         if (nobl.gt.0) then
  41.           do iran = 1, mran
  42.             do ic1 = 1, nobl
  43.               deche = pilobl(ic1,iran)
  44.               if (deche.gt.0) then
  45. ******            segact deche
  46. c          write(6,*) 'comtri deche ',deche,nomdec,typdec,iran,cmate
  47.                 ICMN = MIN(IC1,NBTYPE)
  48. *           write(6,*) 'comtri '  , ic1,iran,LESOBL(IC1)(1:4), notype
  49.                 if (typdec.ne.type(icmn)) then
  50.                   MOTERR(1:16)=typdec
  51.                   MOTERR(17:20)=nomdec
  52.                   MOTERR(21:36)=' utile '
  53.                   CALL ERREUR(552)
  54.                   return
  55.                 endif
  56.               endif
  57.             enddo
  58.           enddo
  59.         endif
  60.         if (nfac.gt.0) then
  61.           do iran = 1, mran
  62.             do ic1 = 1,nfac
  63.               deche = pilfac(ic1,iran)
  64.               if (deche.gt.0) then
  65. ******            segact deche
  66.                 ICMN=MIN((IC1+nobl),NBTYPE)
  67. c       write(6,*) 'comtrifac',deche,nomdec,typdec,iran,nbtype,type(icmn)
  68.                 if (typdec.ne.type(icmn)) then
  69.                   MOTERR(1:16)=typdec
  70.                   MOTERR(17:20)=nomdec
  71.                   MOTERR(21:36)=' utile '
  72.                   CALL ERREUR(552)
  73.                   return
  74.                 endif
  75.               endif
  76.             enddo
  77.           enddo
  78.         endif
  79.  101    continue
  80.         segsup notype
  81.  100    continue
  82.       enddo
  83. *
  84.       RETURN
  85.       END
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  

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