Télécharger vermat.eso

Retour à la liste

Numérotation des lignes :

  1. C VERMAT SOURCE PV 16/11/17 22:01:42 9180
  2. SUBROUTINE VERMAT(MATRIK,IMPR,IRET)
  3. C***********************************************************************
  4. C NOM : VERMAT
  5. C DESCRIPTION :
  6. C Ce sous-programme vérifie l'objet matrice morse assemblée
  7. C du segment MATRIK (segments
  8. C MINC duaux et primaux identiques, nb d'inconnues...)
  9. C en vue de la résolution itérative.
  10. C
  11. C
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES : -
  18. C***********************************************************************
  19. C ENTREES : MATRIK, IMPR
  20. C ENTREES/SORTIES : -
  21. C SORTIES : IRET
  22. C CODE RETOUR (IRET) : 0 si ok
  23. C <0 si problème
  24. C MATRIK : pointeur sur segment MATRIK de l'include SMMATRIK
  25. C contenant la matrice morse à vérifier
  26. C IMPR : niveau d'impression (0..3)
  27. C***********************************************************************
  28. C VERSION : v1, 01/04/98, version initiale
  29. C HISTORIQUE : v1, 01/04/98, création
  30. C HISTORIQUE :
  31. C HISTORIQUE :
  32. C***********************************************************************
  33. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34. C en cas de modification de ce sous-programme afin de faciliter
  35. C la maintenance !
  36. C***********************************************************************
  37. IMPLICIT INTEGER(I-N)
  38. IMPLICIT REAL*8 (A-H,O-Z)
  39.  
  40.  
  41. -INC PPARAM
  42. -INC CCOPTIO
  43. POINTEUR KMORS.PMORS
  44. POINTEUR KISA.IZA
  45. CHARACTER*4 NOMINC
  46. LOGICAL OK
  47. C***
  48.  
  49. IRET=0
  50. OK=.TRUE.
  51. C On récupère les segments utiles
  52. IF (IMPR.GT.5) THEN
  53. WRITE(IOIMP,*) 'vermat.eso : Checking MATRIK',MATRIK
  54. ENDIF
  55. SEGACT MATRIK*MOD
  56. C Vérification des dimensions
  57. KMORS=KIDMAT(4)
  58. KISA =KIDMAT(5)
  59. IF (KMORS.EQ.0.OR.KISA.EQ.0) THEN
  60. WRITE(IOIMP,*) 'Le segment ne contient pas de matrice morse'
  61. WRITE(IOIMP,*) 'KMORS=',KMORS
  62. WRITE(IOIMP,*) 'KISA =',KISA
  63. IRET=-1
  64. ELSE
  65. IF(IMPR.GT.5) THEN
  66. WRITE(IOIMP,*) 'Vérification des dimensions...'
  67. ENDIF
  68. SEGACT KMORS
  69. NTT =KMORS.IA(/1)-1
  70. NJA =KMORS.JA(/1)
  71. SEGDES KMORS
  72. IF (KNTTT.EQ.0) KNTTT=NTT
  73. IF (KNTTP.EQ.0) KNTTP=NTT
  74. IF (KNTTD.EQ.0) KNTTD=NTT
  75. IF (KNTTT.NE.NTT.OR.KNTTP.NE.NTT.OR.KNTTD.NE.NTT) THEN
  76. WRITE(IOIMP,*) 'Dimensions non concordantes.'
  77. IRET=-2
  78. OK=.FALSE.
  79. ENDIF
  80. IF(IMPR.GT.5.OR.(.NOT.OK)) THEN
  81. WRITE(IOIMP,*) 'KNTTT=',KNTTT
  82. WRITE(IOIMP,*) 'KNTTP=',KNTTP
  83. WRITE(IOIMP,*) 'KNTTD=',KNTTD
  84. WRITE(IOIMP,*) 'NTT =',NTT
  85. WRITE(IOIMP,*) 'NJA =',NJA
  86. WRITE(IOIMP,*) 'Vérification des supports géométriques...'
  87. ENDIF
  88. ISPG=0
  89. OK=.TRUE.
  90. IF (KISPGP.NE.0) ISPG=KISPGP
  91. IF (KISPGD.NE.0) ISPG=KISPGD
  92. IF (KISPGT.NE.0) ISPG=KISPGT
  93. IF (ISPG.EQ.0) THEN
  94. WRITE(IOIMP,*) 'Pas de supports géométriques ?'
  95. IRET=-3
  96. OK=.FALSE.
  97. ENDIF
  98. IF (KISPGP.EQ.0) KISPGP=ISPG
  99. IF (KISPGD.EQ.0) KISPGD=ISPG
  100. IF (KISPGT.EQ.0) KISPGT=ISPG
  101. IF (KISPGP.NE.ISPG.OR.KISPGD.NE.ISPG.OR.KISPGT.NE.ISPG) THEN
  102. WRITE(IOIMP,*) 'SPGs non concordants.'
  103. IRET=-4
  104. OK=.FALSE.
  105. ENDIF
  106. IF(IMPR.GT.5.OR.(.NOT.OK)) THEN
  107. WRITE(IOIMP,*) 'KISPGT=',KISPGT
  108. WRITE(IOIMP,*) 'KISPGP=',KISPGP
  109. WRITE(IOIMP,*) 'KISPGD=',KISPGD
  110. WRITE(IOIMP,*) 'Vérification des segments MINC...'
  111. ENDIF
  112. IMINC=0
  113. OK=.TRUE.
  114. IF (KMINCP.NE.0) IMINC=KMINCP
  115. IF (KMINCD.NE.0) IMINC=KMINCD
  116. IF (KMINC .NE.0) IMINC=KMINC
  117. IF (IMINC.EQ.0) THEN
  118. WRITE(IOIMP,*) 'Pas de supports géométriques ?'
  119. IRET=-5
  120. OK=.FALSE.
  121. ENDIF
  122. IF (KMINCP.EQ.0) KMINCP=IMINC
  123. IF (KMINCD.EQ.0) KMINCD=IMINC
  124. IF (KMINC .EQ.0) KMINC =IMINC
  125. IF (KMINCP.NE.IMINC.OR.KMINCD.NE.IMINC.OR.KMINC.NE.IMINC) THEN
  126. WRITE(IOIMP,*) 'Segments MINC non concordants.'
  127. IRET=-6
  128. OK=.FALSE.
  129. ENDIF
  130. IF(IMPR.GT.5.OR.(.NOT.OK)) THEN
  131. WRITE(IOIMP,*) 'KMINC =',KMINC
  132. WRITE(IOIMP,*) 'KMINCP=',KMINCP
  133. WRITE(IOIMP,*) 'KMINCD=',KMINCD
  134. ENDIF
  135. ENDIF
  136. SEGDES MATRIK
  137. IF (IRET.NE.0) GOTO 9999
  138. *
  139. * Normal termination
  140. *
  141. RETURN
  142. *
  143. * Format handling
  144. *
  145. *
  146. * Error handling
  147. *
  148. 9999 CONTINUE
  149. WRITE(IOIMP,*) 'An error was detected in vermat.eso'
  150. RETURN
  151. *
  152. * End of VERMAT
  153. *
  154. END
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  

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