Télécharger erre.eso

Retour à la liste

Numérotation des lignes :

  1. C ERRE SOURCE CB215821 16/12/05 21:39:23 9237
  2. SUBROUTINE ERRE
  3. C_______________________________________________________________________
  4. C
  5. C OPERATEUR ERRE
  6. C --------------
  7. C
  8. C PASSAGE AUX NOUVEAUX MCHAMLS PAR JM CAMPENON LE 02/91
  9. C
  10. C_______________________________________________________________________
  11. C
  12. IMPLICIT INTEGER(I-N)
  13. IMPLICIT REAL*8(A-H,O-Z)
  14. C
  15. -INC CCOPTIO
  16. -INC SMTEXTE
  17. -INC SMLCHPO
  18. -INC SMLREEL
  19. -INC SMLENTI
  20. -INC SMLMOTS
  21. C
  22. CHARACTER AUX*73
  23. LOGICAL ZAVEC
  24. C
  25. AUX=' '
  26. ZAVEC=.FALSE.
  27. C
  28. CALL LIRCHA(AUX,0,IRETOU)
  29. IF (IRETOU.EQ.0) GOTO 250
  30. CALL LENCHA(AUX,LAUX)
  31. ZAVEC=(AUX(1:LAUX).EQ.'AVEC')
  32. IF (ZAVEC) GOTO 250
  33. WRITE(IOIMP,11) AUX
  34. 11 FORMAT(/,(1X,A73))
  35. CALL ERREUR(308)
  36. RETURN
  37. C
  38. 250 CALL LIRENT (KENT,0,IRETOU)
  39. IF (IRETOU.EQ.0) GOTO 255
  40. C MOT-CLE "AVEC"
  41. IF (ZAVEC) THEN
  42. C MOTERR = 40 PREMIERS CARACTERES D'UNE CHAINE
  43. CALL LIRCHA(MOTERR,0,IRET)
  44. C INTERR = ENTIER OU LISTE D'ENTIERS
  45. CALL LIRENT(INTERR(1),0,IRET)
  46. IF (IRET.EQ.0) THEN
  47. CALL LIROBJ('LISTENTI',MLENTI,0,IRET)
  48. IF (IRET.NE.0) THEN
  49. SEGACT,MLENTI
  50. NN=MIN(LECT(/1),INT(SIZE(INTERR)))
  51. DO I=1,NN
  52. INTERR(I)=LECT(I)
  53. ENDDO
  54. SEGDES,MLENTI
  55. ENDIF
  56. ENDIF
  57. C REAERR = ENTIER OU LISTE D'ENTIERS
  58. CALL LIRREE(REAERR(1),0,IRET)
  59. IF (IRET.EQ.0) THEN
  60. CALL LIROBJ('LISTREEL',MLREEL,0,IRET)
  61. IF (IRET.NE.0) THEN
  62. SEGACT,MLREEL
  63. NN=MIN(PROG(/1),INT(SIZE(REAERR)))
  64. DO I=1,NN
  65. REAERR(I)=PROG(I)
  66. ENDDO
  67. SEGDES,MLREEL
  68. ENDIF
  69. ENDIF
  70. C BOOERR = LOGIQUE OU LISTE DE MOTS
  71. CALL LIRLOG(BOOERR(1),0,IRET)
  72. IF (IRET.EQ.0) THEN
  73. CALL LIROBJ('LISTMOTS',MLMOTS,0,IRET)
  74. IF (IRET.NE.0) THEN
  75. SEGACT,MLMOTS
  76. NN=MIN(MOTS(/2),INT(SIZE(BOOERR)))
  77. DO I=1,NN
  78. IF ((MOTS(I).EQ.'VRAI') .OR.
  79. & (MOTS(I).EQ.'V' ) .OR.
  80. & (MOTS(I).EQ.'TRUE') .OR.
  81. & (MOTS(I).EQ.'T' )) THEN
  82. BOOERR(I)=.TRUE.
  83. ELSE
  84. BOOERR(I)=.FALSE.
  85. ENDIF
  86. ENDDO
  87. SEGDES,MLMOTS
  88. ENDIF
  89. ENDIF
  90. ENDIF
  91. CALL ERREUR(KENT)
  92. RETURN
  93.  
  94. 255 CALL LIROBJ('CHPOINT ',IPO1,0,IRETOU)
  95. IF (IRETOU.EQ.0) GOTO 256
  96. CALL LIROBJ('CHPOINT ',IPO2,1,IRETOU)
  97. IF (IERR.NE.0) RETURN
  98. CALL ADCHPO(IPO1,IPO2,IRET,1D0,-1D0)
  99. IF (IRET.EQ.0) RETURN
  100. call ecrCHA('ABS')
  101. CALL ECROBJ('CHPOINT ',IRET)
  102. CALL MAXIMU(1)
  103. RETURN
  104.  
  105. 256 CALL LIROBJ('LISTCHPO',IPO1,0,IRETOU)
  106. IF (IRETOU.EQ.0) GOTO 260
  107. CALL LIROBJ('LISTCHPO',IPO2,1,IRETOU)
  108. IF (IERR.NE.0) RETURN
  109.  
  110. mlchp1 = ipo1
  111. mlchp2 = ipo2
  112. segact mlchp1, mlchp2
  113. if (mlchp1.ichpoi(/1).ne.mlchp2.ichpoi(/1)) call erreur(3)
  114. if (ierr.ne.0) return
  115. JG = mlchp1.ichpoi(/1)
  116. segini mlreel
  117. do ii = 1 ,jg
  118. ipo1 = mlchp1.ichpoi(ii)
  119. ipo2 = mlchp2.ichpoi(ii)
  120. CALL ADCHPO(IPO1,IPO2,IRET,1D0,-1D0)
  121. IF (IRET.EQ.0) RETURN
  122. call ecrCHA('ABS')
  123. CALL ECROBJ('CHPOINT ',IRET)
  124. CALL MAXIMU(1)
  125. call lirree(xx,1,iretou)
  126. if (ierr.ne.0) return
  127. prog(ii) = xx
  128. enddo
  129. call ECROBJ('LISTREEL',mlreel)
  130. RETURN
  131.  
  132. C_______________________________________________________________________
  133. C
  134. C CALCUL D'ERREUR ( VERSION BARZIC ET RICHARD )
  135. C_______________________________________________________________________
  136. C
  137. 260 CONTINUE
  138. CALL LIROBJ('MMODEL',IPMODL,1,IRETM)
  139. IF (IERR.NE.0) RETURN
  140. C
  141. CALL LIROBJ('MCHAML',IPIN,1,IRETOU)
  142. IF (IERR.NE.0)RETURN
  143. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  144. IF(IR .NE. 1) CALL ERREUR(KER)
  145. IF(IERR .NE. 0) RETURN
  146.  
  147. CALL LIROBJ('MCHAML',IPIN,1,IRETOU)
  148. IF (IERR.NE.0) RETURN
  149. CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
  150. IF(IR .NE. 1) CALL ERREUR(KER)
  151. IF(IERR .NE. 0) RETURN
  152. C
  153. CALL RNGCHA (IPCHE1,IPCHE2,'CONTRAINTES','CARACTERISTIQUES'
  154. 1 ,IPCH1,IPCH2)
  155. IF(IPCH1.EQ.0.OR.IPCH2.EQ.0)THEN
  156. IF(IPCH1.EQ.0)THEN
  157. MOTERR(1:16)='CONTRAINTES '
  158. ELSE
  159. MOTERR(1:16)='CARACTERISTIQUES'
  160. ENDIF
  161. CALL ERREUR(565)
  162. RETURN
  163. ENDIF
  164. C
  165. CALL ERRARE(IPMODL,IPCH1,IPCH2,XERR,IPCHRR)
  166. C
  167. IF (IPCHRR.NE.0) THEN
  168. CALL ECROBJ('MCHAML',IPCHRR)
  169. CALL ECRREE(XERR)
  170. ENDIF
  171.  
  172. RETURN
  173. END
  174.  
  175.  
  176.  

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