Télécharger cotemo.eso

Retour à la liste

Numérotation des lignes :

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

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