Télécharger cotemo.eso

Retour à la liste

Numérotation des lignes :

  1. C COTEMO SOURCE CB215821 17/01/16 21:15:16 9279
  2. SUBROUTINE COTEMO(IP1,MFR)
  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
  8. c-----------------------------------------------------------------------
  9. IMPLICIT INTEGER(I-N)
  10. -INC CCOPTIO
  11. -INC SMELEME
  12. -INC SMMODEL
  13. pointeur nomid1.nomid
  14. segment NOMLIS
  15. CHARACTER*8 LESCOM(NTOT)
  16. CHARACTER*8 lecham(ntot)
  17. endsegment
  18. *
  19. character*8 mocham, moref
  20.  
  21. imodel = ip1
  22. ntot = 0
  23. segini nomlis
  24. nfor=formod(/2)
  25. ithe=0
  26. CALL PLACE(FORMOD,NFOR,IMAGN,'MAGNETODYNAMIQUE')
  27. CALL PLACE(FORMOD,NFOR,IDIFF,'DIFFUSION')
  28. CALL PLACE(FORMOD,NFOR,IELEC,'ELECTROSTATIQUE')
  29. CALL PLACE(FORMOD,NFOR,ITHEHY,'THERMOHYDRIQUE')
  30. CALL PLACE(FORMOD,NFOR,IRAYO,'RAYONNEMENT')
  31. CALL PLACE(FORMOD,NFOR,ICONV,'CONVECTION')
  32. CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE')
  33. ithe=ithehy+iconv+ither+irayo
  34.  
  35. do lm = 1,22
  36.  
  37. MOCOMP=0
  38. mocham = ' '
  39.  
  40. goto (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
  41. & 16, 17, 18, 19, 20, 21, 22) lm
  42.  
  43. 1 NBROBL=1
  44. NBRFAC=0
  45. SEGINI NOMID
  46. LESOBL(1)='SCAL '
  47. MOCOMP=NOMID
  48. mocham = 'RESERVE '
  49. GOTO 120
  50. *
  51. 2 NBROBL=1
  52. NBRFAC=0
  53. SEGINI NOMID
  54. LESOBL(1)='MAHO '
  55. MOCOMP=NOMID
  56. mocham = 'MAHOOKE '
  57. GOTO 120
  58. *
  59. 3 NBROBL=1
  60. NBRFAC=0
  61. SEGINI NOMID
  62. LESOBL(1)='TEMP '
  63. MOCOMP=NOMID
  64. mocham = 'RESERVE '
  65. GOTO 120
  66. *
  67. 4 continue
  68. GOTO 120
  69.  
  70. 5 continue
  71. GOTO 120
  72. *
  73. 6 CALL IDPRIM(IMODEL,MFR,MOCOMP,NOBL,NFAC)
  74. mocham = 'DEPLACEM'
  75. GOTO 120
  76. *
  77. 7 CALL IDDUAL(IMODEL,MFR,MOCOMP,NOBL,NFAC)
  78. mocham = 'FORCES '
  79. GOTO 120
  80. *
  81. 8 continue
  82. GOTO 120
  83.  
  84. 9 continue
  85. GOTO 120
  86. *
  87. 10 if(lnomid(3).ne.0) then
  88. mocomp=lnomid(3)
  89. else
  90. CALL IDGRAD(MFR,IFOUR,MOCOMP,NOBL,NFAC)
  91. IF (IDIFF.EQ.1) THEN
  92. nomid = mocomp
  93. segact,nomid*MOD
  94. C*8 lesobl(1)(2:7) = TYMODE(1)(1:6)
  95. lesobl(1)(2:3) = TYMODE(1)(1:2)
  96. segdes,nomid
  97. ENDIF
  98. endif
  99. mocham = 'GRADIENT'
  100. GOTO 120
  101. *
  102. 11 if(lnomid(4).ne.0) then
  103. mocomp=lnomid(4)
  104. else
  105. CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  106. endif
  107. mocham = 'CONTRAIN'
  108. GOTO 120
  109. *
  110. 12 if(lnomid(5).ne.0) then
  111. mocomp=lnomid(5)
  112. else
  113. CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  114. endif
  115. mocham = 'DEFORMAT'
  116. GOTO 120
  117. *
  118. 13 if(lnomid(6).ne.0) then
  119. mocomp=lnomid(6)
  120. else
  121. CALL IDMATR(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  122. endif
  123. mocham = 'MATERIAU'
  124. GOTO 120
  125. *
  126. 14 if(lnomid(7).ne.0) then
  127. mocomp=lnomid(7)
  128. else
  129. CALL IDCARB(MELE,IFOUR,MOCOMP,NOBL,NFAC)
  130. endif
  131. mocham = 'CARACTER'
  132. GOTO 120
  133. *
  134. 15 if(lnomid(8).ne.0) then
  135. mocomp=lnomid(8)
  136. else
  137. CALL IDTEMP(MFR,IFOUR,NPINT,MOCOMP,NOBL,NFAC)
  138. endif
  139. mocham = 'TEMPERAT'
  140. GOTO 120
  141. *
  142. 16 if(lnomid(9).ne.0) then
  143. mocomp=lnomid(9)
  144. else
  145. CALL IDPRIN(MFR,IFOUR,MOCOMP,NOBL,NFAC)
  146. endif
  147. mocham = 'PRINCIPA'
  148. GOTO 120
  149. *
  150. 17 if(lnomid(13).ne.0) then
  151. mocomp=lnomid(13)
  152. else
  153. CALL IDDEIN(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  154. endif
  155. mocham = 'DEFINELA'
  156. GOTO 120
  157. *
  158. 18 continue
  159. 19 continue
  160. GOTO 120
  161. *
  162. 20 if(lnomid(10).ne.0) then
  163. mocomp=lnomid(10)
  164. else
  165. CALL IDVARI(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  166. endif
  167. mocham = 'VARINTER'
  168. GOTO 120
  169. *
  170. 21 if(lnomid(11).ne.0) then
  171. mocomp=lnomid(11)
  172. else
  173. CALL IDGRAF(MFR,IFOUR,MOCOMP,NOBL,NFAC)
  174. endif
  175. mocham = 'GRAFLEXI'
  176. GOTO 120
  177. *
  178. 22 if(lnomid(12).ne.0) then
  179. mocomp=lnomid(12)
  180. else
  181. CALL IDPHAS(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  182. endif
  183. mocham = 'PHASES '
  184. GOTO 120
  185. *
  186. 120 CONTINUE
  187. nomid = mocomp
  188. if (nomid.gt.0) then
  189. segact,nomid
  190. nobl=lesobl(/2)
  191. nfac=lesfac(/2)
  192. nto1 = lescom(/2)
  193. ntot = nto1 + nobl + nfac
  194. * write(6,*) 'lm ', lm, mocham, nobl, nfac,'nto1 ', nto1,mfr
  195. segadj nomlis
  196. do im = 1,(nobl+nfac)
  197. lecham(nto1 + im) = mocham
  198. if (im.le.nobl) then
  199. lescom(nto1 + im) = lesobl(im)
  200. else
  201. lescom(nto1 + im) = lesfac(im - nobl)
  202. endif
  203. enddo
  204. segdes,nomid
  205. endif
  206.  
  207. enddo
  208. *
  209. ntot = lescom(/2)
  210. * write(6,*) 'ntot -cotemo', ntot
  211. do 874 in = 1, (ntot - 1)
  212. moref = lescom(in)
  213. mocham = lecham(in)
  214. * write(6,*) 'comp-champ-ref' , in ,moref, mocham
  215. do jm = (in + 1),ntot
  216. * write(6,*) 'comp-champ-tes' , jm, lescom(jm), lecham(jm)
  217. if (lescom(jm).eq.moref) then
  218. if(moref.eq.'EPAI'.and.imagn.ne.0) go to 874
  219. if(moref.eq.'T '. and.ithe.ne.0) go to 874
  220. moterr(1:8) = moref
  221. moterr(9:16) = lecham(in)
  222. moterr(17:24) = lecham(jm)
  223. call erreur(913)
  224. endif
  225. enddo
  226. 874 continue
  227.  
  228. segsup nomlis
  229. return
  230. end
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  

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