Télécharger typchl.eso

Retour à la liste

Numérotation des lignes :

typchl
  1. C TYPCHL SOURCE CB215821 24/04/12 21:17:24 11897
  2.  
  3. C-----------------------------------------------------------------------
  4. * Identification du type d'un MCHAML a partir de ses noms de composante
  5. *
  6. * En entree :
  7. * ipche1 = MCHAML a typer
  8. * ipmod1 = MMODEL associe
  9. *
  10. * ipche1 et ipmod1 sont tous deux actifs en entree et sortie
  11. *
  12. * En sortie :
  13. * TYPE = chaine de caractere, type du MCHAML
  14. * LTYP = longueur de TYPE
  15. *
  16. C-----------------------------------------------------------------------
  17.  
  18. SUBROUTINE TYPCHL(ipche1,ipmod1,type,ltyp)
  19.  
  20. IMPLICIT REAL*8(A-H,O-Z)
  21. IMPLICIT INTEGER(I-N)
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25.  
  26. -INC SMCHAML
  27. -INC SMMODEL
  28.  
  29.  
  30. CHARACTER*(50) type,typ1
  31. CHARACTER*(LOCOMP) mocp,mot
  32. LOGICAL BZONES
  33.  
  34. type = ' '
  35. ltyp = 1
  36.  
  37. mmodel = ipmod1
  38. mchelm = ipche1
  39.  
  40. * Si le MCHAML est vide, on renvoie le type par defaut
  41. nsche=mchelm.ichaml(/1)
  42. IF (nsche.eq.0) GOTO 9000
  43.  
  44. * Si le MCHAML a plus de sous-zones que le modele,
  45. * il doit avoir le meme nombre de sous-zones geometriques
  46. * mais des points supports differents
  47. * Si le MCHAML a moins de zous-zone que le modele,
  48. * on doit chercher les nom des composantes des sous modele qui ont
  49. * meme zone geometrique qu un sous zone du MCHAML
  50.  
  51. NSMOD = mmodel.kmodel(/1)
  52. BZONES= .false.
  53. if (nsche.NE.NSMOD) then
  54. BZONES= .true.
  55. endif
  56.  
  57. * -----------------------------------
  58. * On parcourt les sous-zones du MCHAML
  59. * Celles du MMODEL sont appareillees
  60. * -----------------------------------
  61.  
  62. * On met ltyp a -1 pour distinguer du type par defaut
  63. ltyp = -1
  64.  
  65. * Boucle sur les sous-zones du chamel
  66. DO is = 1, nsche
  67. mchaml = mchelm.ichaml(is)
  68. if (BZONES) then
  69. ipt1=mchelm.imache(is)
  70. do izz=1,NSMOD
  71. imodel = mmodel.kmodel(izz)
  72. ipt2 = imodel.imamod
  73. if (ipt2.eq.ipt1) goto 10
  74. ENDDO
  75. else
  76. imodel = mmodel.kmodel(is)
  77. endif
  78. 10 continue
  79.  
  80. * Boucle sur les composantes du chamel
  81. ncp =mchaml.NOMCHE(/2)
  82. DO icp=1,ncp
  83. mocp=mchaml.NOMCHE(icp)
  84.  
  85. * ITYP indique si un type a deja ete trouve
  86. ITYP=0
  87. *
  88. *
  89. C---------------------------
  90. C Cas des modeles de modele (melange)
  91. C
  92. * Si modele de MELANGE, il faut regarder le NOMID des sous-modeles
  93. * et les noms de phase :
  94. IF (IMODEL.FORMOD(1)(1:8).EQ.'MELANGE ') THEN
  95. C NSMD = imodel.IVAMOD(/1)
  96. C DO ISM=1,NSMD
  97. C
  98. C write(6,*) 'Dans typchl, IMODEL.TYMODE = ',IMODEL.TYMODE(ISM)
  99. C IF (IMODEL.TYMODE(ISM).NE.'IMODEL') THEN
  100. C write(iimpi,*) ' *** Dans typchl.eso'
  101. C CALL ERREUR(26)
  102. C RETURN
  103. C ENDIF
  104. C
  105. C IMODE1=IMODEL.IVAMOD(ISM)
  106. C write(6,*) 'Dans typchl, IMODE1 = ',IMODE1
  107. C SEGINI,IMODE1
  108. C
  109. C On regarde d'abord les noms de phase :
  110. C MOT = IMODE1.CONMOD(17:24)
  111. C write(6,*) 'Dans typchl, IMODE1.CONMOD = ',MOT(1:8)
  112. C IF (MOT(1:4).EQ.MOCP(1:4)) THEN
  113. C IF (LTYP.EQ.-1) THEN
  114. C ITYP=1
  115. C TYPE='CARACTERISTIQUES'
  116. C LTYP=LONG(TYPE)
  117. C ELSE
  118. C IF (TYPE(1:LTYP).NE.'CARACTERISTIQUES') THEN
  119. C LTYP=1
  120. C TYPE=' '
  121. C GOTO 9000
  122. C ENDIF
  123. C ENDIF
  124. C ENDIF
  125. C
  126. C On regarde ensuite les nomid : Appel a TYCOMP
  127. C IPMOD = IMODE1
  128. C CALL TYCOMP(IPMOD,MOCP,TYP1,LTYP1)
  129. C IF (IERR.NE.0) RETURN
  130. C
  131. C IF (LTYP1.NE.0) THEN
  132. C ITYP = 1
  133. C IF (LTYP.EQ.-1) THEN
  134. C LTYP=LTYP1
  135. C TYPE=TYP1(1:LTYP1)
  136. C ELSE
  137. C IF (TYP1(1:LTYP1).NE.TYPE(1:LTYP)) THEN
  138. C LTYP=1
  139. C TYPE=' '
  140. C GOTO 9000
  141. C ENDIF
  142. C ENDIF
  143. C ENDIF
  144. C SEGDES,IMODE1
  145. C ENDDO
  146. C
  147. C Si le type de la 1ere composante pas identifiee dans les sous-modeles
  148. C du modele de melange, on sort :
  149. C IF (ITYP.EQ.0) THEN
  150. C LTYP=1
  151. C TYPE=' '
  152. C GOTO 9000
  153. C ENDIF
  154. C
  155. C Finalement, si modele MELANGE, on ne fait rien !!
  156. C On signale le cas en mettant l'indicateur ltyp a -2
  157. ITYP = 1
  158. LTYP = -2
  159. C
  160. C Fin des modeles de modeles (melange)
  161. C---------------------------
  162. C
  163. ELSE
  164. C
  165. C---------------------------
  166. C Cas de modeles "simples"
  167. C
  168. C Recherche dans les noms de composantes du modele
  169. C
  170. IPMOD = IMODEL
  171. CALL TYCOMP(IPMOD,MOCP,TYP1,LTYP1)
  172. IF (IERR.NE.0) RETURN
  173. C write(6,*) ' Dans typchl : TYP1,LTYP1',TYP1,LTYP1
  174. C
  175. IF (LTYP1.NE.0) THEN
  176. ITYP = 1
  177. IF (LTYP.EQ.-1) THEN
  178. LTYP=LTYP1
  179. TYPE=TYP1(1:LTYP1)
  180. ELSEIF (LTYP.GT.0) THEN
  181. IF (TYP1(1:LTYP1).NE.TYPE(1:LTYP)) THEN
  182. LTYP=1
  183. TYPE=' '
  184. GOTO 9000
  185. ENDIF
  186. ENDIF
  187. ENDIF
  188. ENDIF
  189. C
  190. C Fin des modeles "simples"
  191. C---------------------------
  192. C
  193. C Pas de type identifie pour cette composante :
  194. IF (ITYP.EQ.0) THEN
  195. LTYP=1
  196. TYPE=' '
  197. GOTO 9000
  198. ENDIF
  199.  
  200. C Fin boucle sur les composantes
  201. ENDDO
  202. C
  203. C Fin boucle sur les sous-zones
  204. ENDDO
  205. C
  206. 9000 CONTINUE
  207.  
  208. IF (LTYP.EQ.-1) LTYP=1
  209.  
  210. RETURN
  211. END
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  

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