Télécharger maximu.eso

Retour à la liste

Numérotation des lignes :

  1. C MAXIMU SOURCE JC220346 16/06/15 21:15:04 8971
  2.  
  3. SUBROUTINE MAXIMU(KPLUS)
  4.  
  5. ************************************************************************
  6. *
  7. * M A X I M U
  8. * -----------
  9. *
  10. * SOUS-PROGRAMME ASSOCIE AUX OPERATEURS :
  11. * MAXI ( KPLUS = 1 )
  12. * MINI ( KPLUS =-1 )
  13. *
  14. * FONCTION:
  15. * ---------
  16. *
  17. * DETERMINER LA PLUS GRANDE VALEUR D'UN OBJET (QUAND CELA A UN
  18. * SENS).
  19. *
  20. * PHRASE D'APPEL (EN GIBIANE):
  21. * ----------------------------
  22. *
  23. * |(AVEC)|
  24. * GRANDVAL = MAXI OBJET (| | COMPOS ) ;
  25. * | SANS |
  26. *
  27. * indice2 absc3 ordo4 = MAXI EVOL1 ( 'ABS' )
  28. *
  29. * OBJET3 = MAXI OBJET1 OBJET2 (OBJETi ..)
  30. *
  31. * LES PARENTHESES INDIQUANT DES ARGUMENTS FACULTATIFS.
  32. *
  33. * OPERANDES ET RESULTATS:
  34. * -----------------------
  35. *
  36. * OBJ TYPE_1 OBJET DONT ON CHERCHE LA PLUS GRANDE VALEUR.
  37. * GRANDVAL TYPE_2 PLUS GRANDE VALEUR EXTRAITE DE "OBJ".
  38. * CETTE "PLUS GRANDE VALEUR" EST LA PLUS
  39. * GRANDE EN VALEUR ABSOLUE, MAIS ELLE EST
  40. * RETOURNEE AVEC SON SIGNE.
  41. * AVEC 'MOT ' MOT-CLE INDIQUANT QUE L'ON REGARDE
  42. * UNIQUEMENT,DANS LA RECHERCHE DU MAXIMUM,
  43. * LES VALEURS ASSOCIEES AUX COMPOSANTES CITEES
  44. * DANS "COMPOS".
  45. * C'EST L'OPTION PAR DEFAUT.
  46. * SANS 'MOT ' MOT-CLE INDIQUANT QUE L'ON EXCLUT, DANS LA
  47. * RECHERCHE DU MAXIMUM, LES VALEURS ASSOCIEES
  48. * AUX COMPOSANTES CITEES DANS "COMPOS".
  49. * COMPOS 'LISTMOTS' LISTE DES NOMS DES COMPOSANTES COMPRISES
  50. * OU EXCLUES.
  51. *
  52. * SI TYPE_1 = 'CHPOINT', ALORS
  53. * . TYPE_2 = 'FLOTTANT',
  54. * . LES COMPOSANTES SONT UX,UY,UZ,RX,RY,RZ,LX,...
  55. * SI TYPE_1 = 'LISTENTI', ALORS
  56. * . TYPE_2 = 'ENTIER',
  57. * . ON PRENDS TOUJOURS TOUTES LES COMPOSANTES EN CONSIDERATION.
  58. * SI TYPE_1 = 'LISTREEL', ALORS
  59. * . TYPE_2 = 'FLOTTANT',
  60. * . ON PRENDS TOUJOURS TOUTES LES COMPOSANTES EN CONSIDERATION.
  61. *
  62. * LEXIQUE: (ORDRE ALPHABETIQUE)
  63. * --------
  64. *
  65. * IGRAND ENTIER PLUS GRANDE VALEUR EXTRAITE (CAS DE VALEURS
  66. * ENTIERES).
  67. * IPLMOT ENTIER POINTEUR DE L'OBJET "COMPOS".
  68. * IPOINT ENTIER POINTEUR DE L'OBJET "OBJ".
  69. * IPOS ENTIER NUMERO D'ORDRE DU TYPE DE L'OBJET "OBJ" DANS LA
  70. * LISTE CONTENUE DANS "LISTYP".
  71. * LISTYP ENTIER CONTIENT LES NOMS DES DIFFERENTS TYPES D'OBJET
  72. * DONT ON PEUT RECHERCHER LA PLUS GRANDE VALEUR.
  73. * MOTCLE ENTIER CONTIENT LA CHAINE DE CARACTERES 'AVEC' OU
  74. * 'SANS'.
  75. * NBTYPE ENTIER NOMBRE DE NOMS DANS "LISTYP".
  76. * PGRAND REEL DP PLUS GRANDE VALEUR EXTRAITE (CAS DE VALEURS
  77. * REELLES).
  78. *
  79. * MODE DE FONCTIONNEMENT:
  80. * -----------------------
  81. *
  82. * APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET "OBJ".
  83. *
  84. * SOUS-PROGRAMMES APPELES:
  85. * ------------------------
  86. *
  87. * LIRE, LIRTYP, ECRIRE,MAXIN1, MAXIN2, MAXIN3,MAXICH,
  88. * MAXIN4,MAXIN6,MAXIN7
  89. *
  90. * AUTEUR, DATE DE CREATION:
  91. * -------------------------
  92. *
  93. * PASCAL MANIGOT 5 NOVEMBRE 1984
  94. *
  95. * "MAXIMUM D'UN LISTENTI" AJOUTE LE 19 FEVRIER 1985 (P. MANIGOT)
  96. * "MAXIMUM D'UN LISTREEL" AJOUTE LE 16 AVRIL 1985 (P. MANIGOT)
  97. *
  98. * LANGAGE:
  99. * --------
  100. *
  101. * FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
  102. *
  103. ************************************************************************
  104. *
  105. IMPLICIT INTEGER(I-N)
  106. IMPLICIT REAL*8(A-H,O-Z)
  107. *
  108. -INC CCOPTIO
  109. *
  110. PARAMETER (NBTYPE = 5, NBMOT = 3, NBMO2 = NBMOT-1)
  111. *
  112. CHARACTER*8 LISTYP(NBTYPE),MONTYP
  113. CHARACTER*4 LISMO(NBMOT)
  114. *
  115. CHARACTER*4 MOTCLE
  116. *
  117. DATA LISTYP / 'CHPOINT ','LISTENTI','LISTREEL','MCHAML ',
  118. & 'EVOLUTIO' /
  119. DATA LISMO/'AVEC','SANS','ABS '/
  120. *
  121. * -- LECTURE DU MOT-CLE --
  122. *
  123. LABSO=0
  124. CALL LIRMOT (LISMO,NBMOT,IPLAC,0)
  125. IF (IERR.NE.0) RETURN
  126. IF (IPLAC.EQ.3) THEN
  127. LABSO=1
  128. CALL LIRMOT (LISMO,NBMO2,IPLAC,0)
  129. IF (IERR.NE.0) RETURN
  130. ENDIF
  131. *
  132. * PAR DEFAUT, LES COMPOSANTES NOMMEES SONT LES COMPOSANTES
  133. * PRISES EN COMPTE (ET NON PAS LES COMPOSANTES EXCLUES)
  134. IF (IPLAC.EQ. 0) THEN
  135. MOTCLE = 'AVEC'
  136. ICODE = 0
  137. ELSE
  138. MOTCLE = LISMO(IPLAC)
  139. ICODE = 1
  140. END IF
  141. *
  142. * -- LECTURE DE LA LISTE DES NOMS DES COMPOSANTES --
  143. * (OBLIGATOIRE SI MOT CLE 'AVEC' OU 'SANS' EST PRECISE)
  144. IPLMOT = 0
  145. CALL LIROBJ('LISTMOTS',IPLMOT,ICODE,IRETOU)
  146. IF (IERR.NE.0) RETURN
  147. *
  148. * -- LECTURE DE L'OBJET --
  149. *
  150. CALL QUETYP(MONTYP,0,IRETOU)
  151. IF (IRETOU.EQ.0) THEN
  152. CALL ERREUR(533)
  153. RETURN
  154. ENDIF
  155. DO 5 IPOS=1,NBTYPE
  156. IF (MONTYP.EQ.LISTYP(IPOS)) GOTO 6
  157. 5 CONTINUE
  158. MOTERR(1:8)=MONTYP
  159. CALL ERREUR(39)
  160. RETURN
  161. 6 CONTINUE
  162. CALL LIROBJ(MONTYP,IPOINT,1,IRETOU)
  163.  
  164. c -- MAXIMUM de n OBJETS (de type LISTENTI, LISTREEL ou CHPOINT) --
  165. c if( ipos.eq.2.or.ipos.eq.3) then
  166. if( ipos.le.3 ) then
  167. CALL LIROBJ(MONTYP,IPOINT2,0,IRETOU)
  168. if( iretou.ne.0) then
  169. if( ipos.eq.1 )
  170. & call maxin7(ipoint,ipoint2,ipoint3,montyp,kplus,LABSO)
  171. if( ipos.eq.2.or.ipos.eq.3 )
  172. & call maxin6(ipoint,ipoint2,ipoint3,montyp,kplus,LABSO)
  173. if(ierr.eq.0)call ecrobj(montyp,ipoint3)
  174. return
  175. endif
  176. endif
  177. IF (IERR .NE. 0) RETURN
  178. *
  179. * -- RECHERCHE DU MAXIMUM d'1 OBJET --
  180. *
  181. IF (IPOS .EQ. 1) THEN
  182. *
  183. * RECHERCHE DU MAXIMUM D'UN "CHPOINT":
  184. IPLACE = 0
  185. CALL MAXIN1 (IPOINT,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO)
  186. IF (IERR .NE. 0) RETURN
  187. CALL ECRREE (PGRAND)
  188. *
  189. ELSE IF (IPOS .EQ. 2) THEN
  190. *
  191. * RECHERCHE DU MAXIMUM D'UN 'LISTENTI':
  192. CALL MAXIN2 (IPOINT, IPLACE,IGRAND,KPLUS,LABSO)
  193. IF (IERR .NE. 0) RETURN
  194. CALL ECRENT (IGRAND)
  195. *
  196. ELSE IF (IPOS .EQ. 3) THEN
  197. *
  198. * RECHERCHE DU MAXIMUM D'UN 'LISTREEL':
  199. CALL MAXIN3 (IPOINT, IPLACE,PGRAND,KPLUS,LABSO)
  200. IF (IERR .NE. 0) RETURN
  201. CALL ECRREE (PGRAND)
  202. *
  203. ELSE IF (IPOS .EQ. 4) THEN
  204. *
  205. * RECHERCHE DU MAXIMUM D'UN "MCHAML":
  206. IPLACE = 0
  207. CALL MAXICH (IPOINT,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO)
  208. IF (IERR .NE. 0) RETURN
  209. CALL ECRREE (PGRAND)
  210. *
  211. ELSE IF (IPOS .EQ. 5) THEN
  212. *
  213. * RECHERCHE DU MAXIMUM D'UNE "EVOLUTIO":
  214. IPLACE = 0
  215. CALL MAXIN4 (IPOINT,IPLACE,AGRAND,OGRAND,KPLUS,LABSO,IGRAND,
  216. &JGRAND)
  217. IF (IERR .NE. 0) RETURN
  218. if(igrand.eq.0.and.jgrand.eq.0) then
  219. CALL ECRREE (OGRAND)
  220. CALL ECRREE (AGRAND)
  221. CALL ECRENT(IPLACE)
  222. else
  223. CALL ECROBJ('LISTREEL',JGRAND)
  224. CALL ECROBJ('LISTREEL',IGRAND)
  225. CALL ECROBJ('LISTENTI',IPLACE)
  226. endif
  227. END IF
  228. *
  229. RETURN
  230. END
  231.  
  232.  
  233.  
  234.  
  235.  

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