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.  
  109. -INC PPARAM
  110. -INC CCOPTIO
  111. *
  112. PARAMETER (NBTYPE = 5, NBMOT = 3, NBMO2 = NBMOT-1)
  113. *
  114. CHARACTER*8 LISTYP(NBTYPE),MONTYP
  115. CHARACTER*4 LISMO(NBMOT)
  116. *
  117. CHARACTER*4 MOTCLE
  118. *
  119. DATA LISTYP / 'CHPOINT ','LISTENTI','LISTREEL','MCHAML ',
  120. & 'EVOLUTIO' /
  121. DATA LISMO/'AVEC','SANS','ABS '/
  122. *
  123. * -- LECTURE DU MOT-CLE --
  124. *
  125. LABSO=0
  126. CALL LIRMOT (LISMO,NBMOT,IPLAC,0)
  127. IF (IERR.NE.0) RETURN
  128. IF (IPLAC.EQ.3) THEN
  129. LABSO=1
  130. CALL LIRMOT (LISMO,NBMO2,IPLAC,0)
  131. IF (IERR.NE.0) RETURN
  132. ENDIF
  133. *
  134. * PAR DEFAUT, LES COMPOSANTES NOMMEES SONT LES COMPOSANTES
  135. * PRISES EN COMPTE (ET NON PAS LES COMPOSANTES EXCLUES)
  136. IF (IPLAC.EQ. 0) THEN
  137. MOTCLE = 'AVEC'
  138. ICODE = 0
  139. ELSE
  140. MOTCLE = LISMO(IPLAC)
  141. ICODE = 1
  142. END IF
  143. *
  144. * -- LECTURE DE LA LISTE DES NOMS DES COMPOSANTES --
  145. * (OBLIGATOIRE SI MOT CLE 'AVEC' OU 'SANS' EST PRECISE)
  146. IPLMOT = 0
  147. CALL LIROBJ('LISTMOTS',IPLMOT,ICODE,IRETOU)
  148. IF (IERR.NE.0) RETURN
  149. *
  150. * -- LECTURE DE L'OBJET --
  151. *
  152. CALL QUETYP(MONTYP,0,IRETOU)
  153. IF (IRETOU.EQ.0) THEN
  154. CALL ERREUR(533)
  155. RETURN
  156. ENDIF
  157. DO 5 IPOS=1,NBTYPE
  158. IF (MONTYP.EQ.LISTYP(IPOS)) GOTO 6
  159. 5 CONTINUE
  160. MOTERR(1:8)=MONTYP
  161. CALL ERREUR(39)
  162. RETURN
  163. 6 CONTINUE
  164. CALL LIROBJ(MONTYP,IPOINT,1,IRETOU)
  165.  
  166. c -- MAXIMUM de n OBJETS (de type LISTENTI, LISTREEL ou CHPOINT) --
  167. c if( ipos.eq.2.or.ipos.eq.3) then
  168. if( ipos.le.3 ) then
  169. CALL LIROBJ(MONTYP,IPOINT2,0,IRETOU)
  170. if( iretou.ne.0) then
  171. if( ipos.eq.1 )
  172. & call maxin7(ipoint,ipoint2,ipoint3,montyp,kplus,LABSO)
  173. if( ipos.eq.2.or.ipos.eq.3 )
  174. & call maxin6(ipoint,ipoint2,ipoint3,montyp,kplus,LABSO)
  175. if(ierr.eq.0)call ecrobj(montyp,ipoint3)
  176. return
  177. endif
  178. endif
  179. IF (IERR .NE. 0) RETURN
  180. *
  181. * -- RECHERCHE DU MAXIMUM d'1 OBJET --
  182. *
  183. IF (IPOS .EQ. 1) THEN
  184. *
  185. * RECHERCHE DU MAXIMUM D'UN "CHPOINT":
  186. IPLACE = 0
  187. CALL MAXIN1 (IPOINT,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO)
  188. IF (IERR .NE. 0) RETURN
  189. CALL ECRREE (PGRAND)
  190. *
  191. ELSE IF (IPOS .EQ. 2) THEN
  192. *
  193. * RECHERCHE DU MAXIMUM D'UN 'LISTENTI':
  194. CALL MAXIN2 (IPOINT, IPLACE,IGRAND,KPLUS,LABSO)
  195. IF (IERR .NE. 0) RETURN
  196. CALL ECRENT (IGRAND)
  197. *
  198. ELSE IF (IPOS .EQ. 3) THEN
  199. *
  200. * RECHERCHE DU MAXIMUM D'UN 'LISTREEL':
  201. CALL MAXIN3 (IPOINT, IPLACE,PGRAND,KPLUS,LABSO)
  202. IF (IERR .NE. 0) RETURN
  203. CALL ECRREE (PGRAND)
  204. *
  205. ELSE IF (IPOS .EQ. 4) THEN
  206. *
  207. * RECHERCHE DU MAXIMUM D'UN "MCHAML":
  208. IPLACE = 0
  209. CALL MAXICH (IPOINT,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO)
  210. IF (IERR .NE. 0) RETURN
  211. CALL ECRREE (PGRAND)
  212. *
  213. ELSE IF (IPOS .EQ. 5) THEN
  214. *
  215. * RECHERCHE DU MAXIMUM D'UNE "EVOLUTIO":
  216. IPLACE = 0
  217. CALL MAXIN4 (IPOINT,IPLACE,AGRAND,OGRAND,KPLUS,LABSO,IGRAND,
  218. &JGRAND)
  219. IF (IERR .NE. 0) RETURN
  220. if(igrand.eq.0.and.jgrand.eq.0) then
  221. CALL ECRREE (OGRAND)
  222. CALL ECRREE (AGRAND)
  223. CALL ECRENT(IPLACE)
  224. else
  225. CALL ECROBJ('LISTREEL',JGRAND)
  226. CALL ECROBJ('LISTREEL',IGRAND)
  227. CALL ECROBJ('LISTENTI',IPLACE)
  228. endif
  229. END IF
  230. *
  231. RETURN
  232. END
  233.  
  234.  
  235.  
  236.  
  237.  

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