Télécharger normod.eso

Retour à la liste

Numérotation des lignes :

  1. C NORMOD SOURCE PV 09/03/12 21:29:37 6325
  2. SUBROUTINE NORMOD(ITBAS,LCHAIN)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5.  
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Normalise le mode *
  9. * *
  10. * Param}tres: *
  11. * *
  12. * e ITBAS table de sous-type BASE_DE_MODES contenant les modes *
  13. * de la structure *
  14. * *
  15. * Auteur, date de cr{ation: *
  16. * *
  17. * Lionel VIVAN, le 15 juin 1990. *
  18. * *
  19. *--------------------------------------------------------------------*
  20. * *
  21. -INC CCOPTIO
  22. -INC SMCHPOI
  23. -INC SMCHAML
  24. -INC SMTABLE
  25. *
  26. INTEGER LCHAIN(*)
  27. CHARACTER*4 COMP
  28. *
  29. MTABLE = ITBAS
  30. SEGACT MTABLE
  31. LONG = MLOTAB
  32. IM = 1
  33. DO 10 I = 1,LONG
  34. IF (MTABTI(I).EQ.'ENTIER ' .AND. MTABII(I).EQ.IM .AND.
  35. & MTABTV(I).EQ.'TABLE ') THEN
  36. ITMOD = MTABIV(I)
  37. IM = IM + 1
  38. MTAB1 = ITMOD
  39. SEGACT MTAB1
  40. LON1 = MTAB1.MLOTAB
  41. XGRA = 0.D0
  42. DO 20 I1 = 1,LON1
  43. IF (MTAB1.MTABTI(I1).EQ.'MOT ' .AND.
  44. & MTAB1.MTABII(I1).EQ.LCHAIN(3) .AND.
  45. & MTAB1.MTABTV(I1).EQ.'CHPOINT ') THEN
  46. ICHDEP = MTAB1.MTABIV(I1)
  47. MCHPOI = ICHDEP
  48. SEGACT MCHPOI
  49. NSOU = IPCHP(/1)
  50. DO 22 INS = 1,NSOU
  51. MSOUPO = IPCHP(INS)
  52. SEGACT MSOUPO
  53. MPOVAL = IPOVAL
  54. SEGACT MPOVAL
  55. NBP = VPOCHA(/1)
  56. NBC = VPOCHA(/2)
  57. DO 24 IC = 1,NBC
  58. COMP = NOCOMP(IC)
  59. IF (COMP(1:1).EQ.'U' .OR. COMP(1:1).EQ.'R') THEN
  60. DO 26 IP = 1,NBP
  61. XVAL = VPOCHA(IP,IC)
  62. XAVA = ABS(XVAL)
  63. IF (XAVA.GT.XGRA) XGRA = XAVA
  64. 26 CONTINUE
  65. * end do
  66. ENDIF
  67. 24 CONTINUE
  68. * end do
  69. SEGDES MPOVAL
  70. SEGDES MSOUPO
  71. 22 CONTINUE
  72. * end do
  73. DO 32 INS = 1,NSOU
  74. MSOUPO = IPCHP(INS)
  75. SEGACT MSOUPO
  76. MPOVAL = IPOVAL
  77. SEGACT MPOVAL
  78. NBP = VPOCHA(/1)
  79. NBC = VPOCHA(/2)
  80. DO 34 IC = 1,NBC
  81. COMP = NOCOMP(IC)
  82. IF (COMP(1:1).EQ.'U' .OR. COMP(1:1).EQ.'R') THEN
  83. DO 36 IP = 1,NBP
  84. XDEP = VPOCHA(IP,IC)
  85. VPOCHA(IP,IC) = XDEP / XGRA
  86. 36 CONTINUE
  87. * end do
  88. ENDIF
  89. 34 CONTINUE
  90. * end do
  91. SEGDES MPOVAL
  92. SEGDES MSOUPO
  93. 32 CONTINUE
  94. * end do
  95. SEGDES MCHPOI
  96. MTAB1.MTABIV(I1) = ICHDEP
  97. ENDIF
  98. 20 CONTINUE
  99. * end do
  100. DO 40 I1 = 1,LON1
  101. IF (MTAB1.MTABTI(I1).EQ.'MOT ') THEN
  102. IF (MTAB1.MTABII(I1).EQ.LCHAIN(2) .AND.
  103. & MTAB1.MTABTV(I1).EQ.'TABLE ') THEN
  104. ITDEP = MTAB1.MTABIV(I1)
  105. MTAB2 = ITDEP
  106. SEGACT MTAB2
  107. LON2 = MTAB2.MLOTAB
  108. IDP = 1
  109. DO 42 I2 = 1,LON2
  110. IF (MTAB2.MTABTI(I2).EQ.'ENTIER ' .AND.
  111. & MTAB2.MTABII(I2).EQ.IDP .AND.
  112. & MTAB2.MTABTV(I2).EQ.'FLOTTANT') THEN
  113. IDP = IDP + 1
  114. XDEPG = MTAB2.RMTABV(I2)
  115. MTAB2.RMTABV(I2) = XDEPG / XGRA
  116. ENDIF
  117. 42 CONTINUE
  118. * end do
  119. SEGDES MTAB2
  120. MTAB1.MTABIV(I1) = ITDEP
  121. ELSE IF (MTAB1.MTABII(I1).EQ.LCHAIN(19) .AND.
  122. & MTAB1.MTABTV(I1).EQ.'FLOTTANT') THEN
  123. XMGEN = MTAB1.RMTABV(I1)
  124. MTAB1.RMTABV(I1) = XMGEN / (XGRA * XGRA)
  125. ELSE IF (MTAB1.MTABII(I1).EQ.LCHAIN(5) .AND.
  126. & MTAB1.MTABTV(I1).EQ.'CHPOINT ') THEN
  127. ICHREA = MTAB1.MTABIV(I1)
  128. MCHPOI = ICHREA
  129. SEGACT MCHPOI
  130. NSOU = IPCHP(/1)
  131. DO 50 INS = 1,NSOU
  132. MSOUPO = IPCHP(INS)
  133. SEGACT MSOUPO
  134. MPOVAL = IPOVAL
  135. SEGACT MPOVAL
  136. NBP = VPOCHA(/1)
  137. NBC = VPOCHA(/2)
  138. DO 52 IC = 1,NBC
  139. DO 54 IP = 1,NBP
  140. XREA = VPOCHA(IP,IC)
  141. VPOCHA(IP,IC) = XREA / XGRA
  142. 54 CONTINUE
  143. * end do
  144. 52 CONTINUE
  145. * end do
  146. SEGDES MPOVAL
  147. SEGDES MSOUPO
  148. 50 CONTINUE
  149. * end do
  150. SEGDES MCHPOI
  151. MTAB1.MTABIV(I1) = ICHREA
  152. ELSE IF (MTAB1.MTABII(I1).EQ.LCHAIN(4) .AND.
  153. & MTAB1.MTABTV(I1).EQ.'MCHAML ') THEN
  154. ICHCON = MTAB1.MTABIV(I1)
  155. MCHELM = ICHCON
  156. SEGACT MCHELM
  157. N1 = IMACHE(/1)
  158. DO 60 IN = 1,N1
  159. MCHAML = ICHAML(IN)
  160. SEGACT MCHAML
  161. NCO = NOMCHE(/1)
  162. DO 62 ICO = 1,NCO
  163. MELVAL = IELVAL(ICO)
  164. SEGACT MELVAL
  165. N1P = VELCHE(/1)
  166. N1E = VELCHE(/2)
  167. DO 64 IP = 1,N1P
  168. DO 66 IE = 1,N1E
  169. XCON = VELCHE(IP,IE)
  170. VELCHE(IP,IE) = XCON/XGRA
  171. 66 CONTINUE
  172. 64 CONTINUE
  173. SEGDES MELVAL
  174. 62 CONTINUE
  175. SEGDES MCHAML
  176. 60 CONTINUE
  177. SEGDES MCHELM
  178. MTAB1.MTABIV(I1) = ICHCON
  179. ENDIF
  180. ENDIF
  181. 40 CONTINUE
  182. * end do
  183. SEGDES MTAB1
  184. ENDIF
  185. 10 CONTINUE
  186. * end do
  187. SEGDES MTABLE
  188. *
  189. END
  190.  
  191.  
  192.  
  193.  

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