Télécharger la plaquette Cast3M


fr en

Télécharger maximu.eso

Retour à la liste

Numérotation des lignes : 

maximu

  1. C MAXIMU    SOURCE    CB215821  21/06/10    21:15:35     11029          
  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. *     KGRAND  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.       CHARACTER*8 LISTYP(NBTYPE),MONTYP
  114.       CHARACTER*4 LISMO(NBMOT)
  115.       CHARACTER*4 MOTCLE
  116.       DATA LISTYP / 'CHPOINT ','LISTENTI','LISTREEL','MCHAML  ',
  117.      &              'EVOLUTIO' /
  118.       DATA LISMO/'AVEC','SANS','ABS '/
  119.  
  120.       LOGICAL ZABSO
  121.  
  122. ************************************************************************
  123. *    LECTURES, INITIALISATION ET AIGUILLAGE
  124. ************************************************************************
  125. *
  126. *     -- LECTURE DU MOT-CLE --
  127. *
  128.       LABSO=0
  129.       CALL LIRMOT (LISMO,NBMOT,IPLAC,0)
  130.       IF (IERR.NE.0) RETURN
  131.       IF (IPLAC.EQ.3) THEN
  132.          LABSO=1
  133.          CALL LIRMOT (LISMO,NBMO2,IPLAC,0)
  134.          IF (IERR.NE.0) RETURN
  135.       ENDIF
  136.       ZABSO=LABSO.eq.1
  137. *
  138. *        PAR DEFAUT, LES COMPOSANTES NOMMEES SONT LES COMPOSANTES
  139. *        PRISES EN COMPTE (ET NON PAS LES COMPOSANTES EXCLUES)
  140.       IF (IPLAC.EQ. 0) THEN
  141.          MOTCLE = 'AVEC'
  142.          ICODE = 0
  143.       ELSE
  144.          MOTCLE = LISMO(IPLAC)
  145.          ICODE = 1
  146.       END IF
  147. *
  148. *     -- LECTURE DE LA LISTE DES NOMS DES COMPOSANTES --
  149. *        (OBLIGATOIRE SI MOT CLE 'AVEC' OU 'SANS' EST PRECISE)
  150.       IPLMOT = 0
  151.       CALL LIROBJ('LISTMOTS',IPLMOT,ICODE,IRETOU)
  152.       IF (IERR.NE.0) RETURN
  153. *
  154. *     -- LECTURE DE L'OBJET --
  155. *
  156.       CALL QUETYP(MONTYP,0,IRETOU)
  157.       IF (IRETOU.EQ.0) THEN
  158.         CALL ERREUR(533)
  159.         RETURN
  160.       ENDIF
  161. *    -cas entier et flottant
  162.       IF(MONTYP.EQ.'ENTIER') GOTO 1
  163.       IF(MONTYP.EQ.'FLOTTANT') GOTO 2      
  164. *    -autres objets
  165.       DO 5 IPOS=1,NBTYPE
  166.         IF (MONTYP.EQ.LISTYP(IPOS)) GOTO 6
  167.    5  CONTINUE
  168. c     ERREUR 39 : On ne veut pas d'objet de type ...
  169.       MOTERR(1:8)=MONTYP
  170.       CALL ERREUR(39)
  171.       RETURN
  172.  
  173.  
  174. ************************************************************************
  175. c     -- MAXIMUM de n FLOTTANTS OU ENTIERS --
  176. ************************************************************************
  177.  
  178. *     ENTIERS
  179.    1  CONTINUE      
  180.       CALL LIRENT(IMAX,1,IRETOU)      
  181.       IF (IERR.NE.0) RETURN
  182.       if (ZABSO) IMAX=ABS(IMAX)
  183.       IF(KPLUS.eq.1) THEN
  184.   11    CALL LIRENT(IVAL,0,IRETOU)
  185.         IF(IRETOU.NE.0) THEN
  186.           if (ZABSO) IVAL=ABS(IVAL)
  187.           IMAX=MAX(IMAX,IVAL)
  188.           GOTO 11
  189.         ENDIF
  190.       ELSEIF(KPLUS.eq.-1) THEN
  191.   12    CALL LIRENT(IVAL,0,IRETOU)
  192.         IF(IRETOU.NE.0) THEN
  193.           if (ZABSO) IVAL=ABS(IVAL)
  194.           IMAX=MIN(IMAX,IVAL)
  195.           GOTO 12
  196.         ENDIF
  197.       ELSE
  198.         CALL ERREUR(5)
  199.         RETURN
  200.       ENDIF
  201.       CALL ECRENT(IMAX)
  202.       RETURN
  203.  
  204. *     FLOTTANTS
  205.    2  CONTINUE      
  206.       CALL LIRREE(XMAX,1,IRETOU)
  207.       IF (IERR.NE.0) RETURN
  208.       if (ZABSO) XMAX=ABS(XMAX)
  209.       IF(KPLUS.eq.1) THEN
  210.   21    CALL LIRREE(XVAL,0,IRETOU)
  211.         IF(IRETOU.NE.0) THEN
  212.           if (ZABSO) XVAL=ABS(XVAL)
  213.           XMAX=MAX(XMAX,XVAL)
  214.           GOTO 21
  215.         ENDIF
  216.       ELSEIF(KPLUS.eq.-1) THEN
  217.   22    CALL LIRREE(XVAL,0,IRETOU)
  218.         IF(IRETOU.NE.0) THEN
  219.           if (ZABSO) XVAL=ABS(XVAL)
  220.           XMAX=MIN(XMAX,XVAL)
  221.           GOTO 22
  222.         ENDIF
  223.       ELSE
  224.         CALL ERREUR(5)
  225.         RETURN
  226.       ENDIF
  227.       CALL ECRREE(XMAX)
  228.       RETURN
  229.  
  230.  
  231.  
  232. ************************************************************************
  233. c     on a trouve un objet compatible dans LISTYP : on le lit
  234. ************************************************************************
  235.    6  CONTINUE
  236.       CALL LIROBJ(MONTYP,IPOINT,1,IRETOU)
  237.       IF(IERR .NE. 0) RETURN
  238.       CALL ACTOBJ(MONTYP,IPOINT,1)
  239.       IF(IERR .NE. 0) RETURN
  240.  
  241. ************************************************************************
  242. c     -- MAXIMUM de n OBJETS (de type LISTENTI, LISTREEL ou CHPOINT) --
  243. ************************************************************************
  244.  
  245. c       if( ipos.eq.2.or.ipos.eq.3) then
  246.       if( ipos.le.3 ) then
  247.         CALL LIROBJ(MONTYP,IPOINT2,0,IRETOU)
  248. c       si on lit un 2nd objet du meme type
  249.         if( iretou.ne.0) then
  250.         CALL ACTOBJ(MONTYP,IPOINT2,1)
  251.         IF(IERR .NE. 0) RETURN
  252. c         CHPOINT
  253.           if( ipos.eq.1 )
  254.      &       call maxin7(ipoint,ipoint2,ipoint3,montyp,kplus,LABSO)
  255. c         LISTENTI ou LISREEL
  256.           if( ipos.eq.2.or.ipos.eq.3 )
  257.      &       call maxin6(ipoint,ipoint2,ipoint3,montyp,kplus,LABSO)
  258.           if(ierr.eq.0)call ecrobj(montyp,ipoint3)
  259.           return
  260.         endif
  261.       endif
  262.       IF (IERR .NE. 0) RETURN
  263. *
  264.  
  265. ************************************************************************
  266. *     -- RECHERCHE DU MAXIMUM d'1 OBJET --
  267. ************************************************************************
  268. *
  269.       IF (IPOS .EQ. 1) THEN
  270. *
  271. *        RECHERCHE DU MAXIMUM D'UN "CHPOINT":
  272.          IPLACE = 0
  273.          CALL MAXIN1 (IPOINT,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO)
  274.          IF (IERR .NE. 0) RETURN
  275.          CALL ECRREE (PGRAND)
  276. *
  277.       ELSE IF (IPOS .EQ. 2) THEN
  278. *
  279. *        RECHERCHE DU MAXIMUM D'UN 'LISTENTI':
  280.          CALL MAXIN2 (IPOINT,  IPLACE,KGRAND,KPLUS,LABSO)
  281.          IF (IERR .NE. 0) RETURN
  282.          CALL ECRENT (KGRAND)
  283. *
  284.       ELSE IF (IPOS .EQ. 3) THEN
  285. *
  286. *        RECHERCHE DU MAXIMUM D'UN 'LISTREEL':
  287.          CALL MAXIN3 (IPOINT,  IPLACE,PGRAND,KPLUS,LABSO)
  288.          IF (IERR .NE. 0) RETURN
  289.          CALL ECRREE (PGRAND)
  290. *
  291.       ELSE IF (IPOS .EQ. 4) THEN
  292. *
  293. *        RECHERCHE DU MAXIMUM D'UN "MCHAML":
  294.          IPLACE = 0
  295.          CALL MAXICH (IPOINT,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO)
  296.          IF (IERR .NE. 0) RETURN
  297.          CALL ECRREE (PGRAND)
  298. *
  299.       ELSE IF (IPOS .EQ. 5) THEN
  300. *
  301. *        RECHERCHE DU MAXIMUM D'UNE "EVOLUTIO":
  302.          IPLACE = 0
  303.          CALL MAXIN4 (IPOINT,IPLACE,AGRAND,OGRAND,KPLUS,LABSO,KGRAND,
  304.      &JGRAND)
  305.          IF (IERR .NE. 0) RETURN
  306.          if(kgrand.eq.0.and.jgrand.eq.0) then
  307.            CALL ECRREE (OGRAND)
  308.            CALL ECRREE (AGRAND)
  309.            CALL ECRENT(IPLACE)
  310.          else
  311.            CALL ECROBJ('LISTREEL',JGRAND)
  312.            CALL ECROBJ('LISTREEL',KGRAND)
  313.            CALL ECROBJ('LISTENTI',IPLACE)
  314.          endif
  315.       END IF
  316. *
  317.       RETURN
  318.       END
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  

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