Télécharger comtri.eso

Retour à la liste

Numérotation des lignes :

  1. C COMTRI SOURCE BP208322 17/03/01 21:16:29 9325
  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. nomid = liluc(ino,1)
  23. c* segact nomid*nomod
  24. nobl = lesobl(/2)
  25. nfac = lesfac(/2)
  26. c* write(ioimp,*) 'comtri ',mfr,inplas,nobl,nfac
  27. call cotype(iqmod,ino,motype,iwrk53,nobl,nfac)
  28. notype = motype
  29. if (notype.eq.0) goto 100
  30. nbtype = type(/2)
  31. if (nbtype.eq.0) goto 101
  32. *
  33. pilnec = liluc(ino,2)
  34. c* segact pilnec*nomod
  35. c* mobl = pilobl(/1) = nobl
  36. c* mfac = pilfac(/1) = nfac
  37. mran = pilobl(/2)
  38. if (nobl.gt.0) then
  39. do iran = 1, mran
  40. do ic1 = 1, nobl
  41. deche = pilobl(ic1,iran)
  42. if (deche.gt.0) then
  43. ****** segact deche
  44. c write(6,*) 'comtri deche ',deche,nomdec,typdec,iran,cmate
  45. ICMN = MIN(IC1,NBTYPE)
  46. * write(6,*) 'comtri ' , ic1,iran,LESOBL(IC1)(1:4), notype
  47. if (typdec.ne.type(icmn)) then
  48. MOTERR(1:16)=typdec
  49. MOTERR(17:20)=nomdec
  50. 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 '
  70. CALL ERREUR(552)
  71. return
  72. endif
  73. endif
  74. enddo
  75. enddo
  76. endif
  77. 101 continue
  78. segsup notype
  79. 100 continue
  80. enddo
  81. *
  82. RETURN
  83. END
  84.  
  85.  
  86.  
  87.  
  88.  

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