Télécharger la plaquette Cast3M


fr en

Télécharger ooowph.eso

Retour à la liste

Numérotation des lignes : 

ooowph

  1. C OOOWPH    SOURCE    PV090527  26/04/24    08:23:32     12524          
  2.       SUBROUTINE OOOWPH (HNOMV,HNOMVA,IDIM,NDIM,NMAX)
  3. C---------------------------------------------------------------------
  4. C
  5. C                 IMPRESSION D'UN SEGMENT : SEGPRT , PSEG*NMAX
  6. C                 (CONTENU DU SEGMENT)
  7. C
  8. C      HNOMV      NOM DU TABLEAU OU DE LA VARIABLE SIMPLE
  9. C
  10. C      *NOMVA     TABLEAU A IMPRIMER
  11. C
  12. C      IDIM(NDIM) DIMENSIONS D'UN TABLEAU
  13. C
  14. C      NDIM       NOMBRE DE DIMENSIONS D'UN TABLEAU
  15. C
  16. C      NMAX       NOMBRE MAXIMUM DE VALEURS A IMPRIMER POUR UN TABLEAU
  17. C
  18. C
  19. C PROGRAMMEUR : M JACQ
  20. C       CREE  : 03/04/89
  21. C
  22. C-----------------------------------------------------------------------
  23. C     NELEM      NOMBRE D'ELEMENTS PAR LIGNE
  24. %INC IOOUNIT
  25.       PARAMETER  (NELEM=5)
  26.       CHARACTER *5   TRADL(NELEM)
  27.       CHARACTER *(*) HNOMV
  28.       INTEGER        IDIM(*)
  29. C
  30. C               DECLARATIONS DE  *NOMVA
  31. C
  32.       CHARACTER *(*) HNOMVA(1)
  33.       LOGICAL    LNOMVA(1)
  34. %IF VAX,PRIME,NORSK
  35.       LOGICAL*2  MNOMVA(1)
  36. %ELSE
  37.       LOGICAL    MNOMVA(1)
  38. %ENDIF
  39. %IF IBM,VAX,SEL,PRIME
  40.       LOGICAL*1  NNOMVA(1)
  41. %ELSE
  42. %IF NORSK
  43.       LOGICAL*2  NNOMVA(1)
  44. %ELSE
  45.       LOGICAL    NNOMVA(1)
  46. %ENDIF
  47. %ENDIF
  48. C
  49.       INTEGER    INOMVA(1)
  50. C
  51. %IF SEL,UNIVAC,CRAY,CFT77,CDC,FPS,NOSVE,UNIX64,WIN64
  52.       INTEGER    JNOMVA(1)
  53. %ELSE
  54.       INTEGER*2  JNOMVA(1)
  55. %ENDIF
  56. C
  57. %IF SEL,UNIVAC,CRAY,CFT77,CDC,FPS,NOSVE,UNIX64,WIN64
  58.       INTEGER    KNOMVA(1)
  59. %ELSE
  60.       INTEGER*2  KNOMVA(1)
  61. %ENDIF
  62. C
  63.       REAL       RNOMVA(1)
  64.       REAL       CNOMVA(2,1)
  65. C
  66. %IF CRAY,CFT77,CDC,FPS,NOSVE,UNIX64,WIN64
  67.       REAL       DNOMVA(1)
  68.       REAL       YNOMVA(2,1)
  69. %ELSE
  70.       REAL*8     DNOMVA(1)
  71.       REAL*8     YNOMVA(2,1)
  72. %ENDIF
  73. C
  74. %IF IBM,VAX,SEL,PRIME
  75.       REAL*16    QNOMVA(1)
  76.       REAL*16    ZNOMVA(2,1)
  77. %ELSE
  78.       REAL*8     QNOMVA(1)
  79.       REAL*8     ZNOMVA(2,1)
  80. %ENDIF
  81. C
  82.       MACRO , (LOGICAL  , LOGICAL_2 , LOGICAL_1
  83.      *      ,  INTEGER  , INTEGER_2 , INTEGER_1
  84.      *      ,  REAL_4   , REAL_8    , REAL_16
  85.      *      ,  COMPLEX  , COMPLEX_16, COMPLEX_32
  86.      *      ,  CHARACTER, POINTEUR                        )
  87. C
  88.       KAS=CHARACTER
  89.                                                        GO TO 20
  90.       ENTRY OOOWPL(HNOMV,LNOMVA,IDIM,NDIM,NMAX)
  91.       KAS=LOGICAL
  92.                                                        GO TO 20
  93.       ENTRY OOOWPM(HNOMV,MNOMVA,IDIM,NDIM,NMAX)
  94.       KAS=LOGICAL_2
  95.                                                        GO TO 20
  96.       ENTRY OOOWPN(HNOMV,NNOMVA,IDIM,NDIM,NMAX)
  97.       KAS=LOGICAL_1
  98.                                                        GO TO 20
  99.       ENTRY OOOWPI(HNOMV,INOMVA,IDIM,NDIM,NMAX)
  100.       KAS=INTEGER
  101.                                                        GO TO 20
  102.       ENTRY OOOWPJ(HNOMV,JNOMVA,IDIM,NDIM,NMAX)
  103.       KAS=INTEGER_2
  104.                                                        GO TO 20
  105.       ENTRY OOOWPK(HNOMV,KNOMVA,IDIM,NDIM,NMAX)
  106.       KAS=INTEGER_1
  107.                                                        GO TO 20
  108.       ENTRY OOOWPR(HNOMV,RNOMVA,IDIM,NDIM,NMAX)
  109.       KAS=REAL_4
  110.                                                        GO TO 20
  111.       ENTRY OOOWPD(HNOMV,DNOMVA,IDIM,NDIM,NMAX)
  112.       KAS=REAL_8
  113.                                                        GO TO 20
  114.       ENTRY OOOWPQ(HNOMV,QNOMVA,IDIM,NDIM,NMAX)
  115.       KAS=REAL_16
  116.                                                        GO TO 20
  117.       ENTRY OOOWPC(HNOMV,CNOMVA,IDIM,NDIM,NMAX)
  118.       KAS=COMPLEX
  119.                                                        GO TO 20
  120.       ENTRY OOOWPY(HNOMV,YNOMVA,IDIM,NDIM,NMAX)
  121.       KAS=COMPLEX_16
  122.                                                        GO TO 20
  123.       ENTRY OOOWPZ(HNOMV,ZNOMVA,IDIM,NDIM,NMAX)
  124.       KAS=COMPLEX_32
  125.                                                        GO TO 20
  126.       ENTRY OOOWPP(HNOMV,INOMVA,IDIM,NDIM,NMAX)
  127.       KAS=POINTEUR
  128. C
  129.   20  CONTINUE
  130. C
  131.       IF(NDIM.EQ.0) THEN
  132. C
  133. C VARIABLE SIMPLE
  134. C
  135.         KDIM=0
  136.         CASE           ,KAS
  137.         WHEN , POINTEUR
  138.           WRITE(JLST,1150) HNOMV(1:MIN(30,LEN(HNOMV)))
  139.         WHENOTHERS
  140.           WRITE(JLST,1100) HNOMV(1:MIN(30,LEN(HNOMV)))
  141.         ENDCASE
  142.       ELSE
  143.         KDIM=1
  144.         CASE           ,KAS
  145.         WHEN , CHARACTER
  146.           IF(NDIM.EQ.1) THEN
  147.             WRITE(JLST,1050) HNOMV(1:MIN(30,LEN(HNOMV))),IDIM(1)
  148.             KDIM   =0
  149.           ELSE
  150. C
  151. C TABLEAU
  152. C
  153.             WRITE(JLST,1050) HNOMV(1:MIN(30,LEN(HNOMV)))
  154.      *                         ,IDIM(1),(IDIM(I),I=2,NDIM)
  155.           ENDIF
  156.         WHEN , POINTEUR
  157.           WRITE(JLST,1150) HNOMV(1:MIN(30,LEN(HNOMV)))
  158.      *                       ,(IDIM(I),I=1,NDIM)
  159.         WHENOTHERS
  160.           WRITE(JLST,1100) HNOMV(1:MIN(30,LEN(HNOMV)))
  161.      *                       ,(IDIM(I),I=1,NDIM)
  162.         ENDCASE
  163.       ENDIF
  164. C
  165.       IF(KDIM.NE.0) THEN
  166. C
  167. C TABLEAU
  168. C
  169.         CASE           ,KAS
  170.         WHEN , CHARACTER
  171.           I2=2
  172.         WHENOTHERS
  173.           I2=1
  174.         ENDCASE
  175.         DO I=I2,NDIM
  176.           KDIM=KDIM*IDIM(I)
  177.         ENDDO
  178.         KDIM=MIN(NMAX,KDIM)
  179. C
  180.         DO I=1,KDIM,NELEM
  181.           IMAX=MIN(I+4,KDIM)
  182. C
  183.           CASE           ,KAS
  184.           WHEN , LOGICAL , LOGICAL_2 , LOGICAL_1
  185.             JMAX=IMAX-I+1
  186.             DO J=1,JMAX
  187.               CASE           ,KAS
  188.               WHEN , LOGICAL
  189.                 IF(LNOMVA(I+J-1)) THEN
  190.                   TRADL(J)='TRUE '
  191.                 ELSE
  192.                   TRADL(J)='FALSE'
  193.                 ENDIF
  194.               WHEN , LOGICAL_2
  195.                 IF(MNOMVA(I+J-1)) THEN
  196.                   TRADL(J)='TRUE '
  197.                 ELSE
  198.                   TRADL(J)='FALSE'
  199.                 ENDIF
  200.               WHEN , LOGICAL_1
  201.                 IF(NNOMVA(I+J-1)) THEN
  202.                   TRADL(J)='TRUE '
  203.                 ELSE
  204.                   TRADL(J)='FALSE'
  205.                 ENDIF
  206.               ENDCASE
  207.             ENDDO
  208.             WRITE(JLST,1200)I,(TRADL(J),J=1,JMAX)
  209.           WHEN , INTEGER , POINTEUR
  210.             WRITE(JLST,1300)I,(INOMVA(J),J=I,IMAX)
  211.           WHEN , INTEGER_2
  212.             WRITE(JLST,1300)I,(JNOMVA(J),J=I,IMAX)
  213.           WHEN , INTEGER_1
  214.             WRITE(JLST,1300)I,(KNOMVA(J),J=I,IMAX)
  215.           WHEN , REAL_4
  216.             WRITE(JLST,1400)I,(RNOMVA(J),J=I,IMAX)
  217.           WHEN , REAL_8
  218.             WRITE(JLST,1400)I,(DNOMVA(J),J=I,IMAX)
  219.           WHEN , REAL_16
  220.             WRITE(JLST,1400)I,(QNOMVA(J),J=I,IMAX)
  221.           WHEN , COMPLEX
  222.             WRITE(JLST,1500)I,(CNOMVA(1,J),J=I,IMAX)
  223.             WRITE(JLST,1550)  (CNOMVA(2,J),J=I,IMAX)
  224.           WHEN , COMPLEX_16
  225.             WRITE(JLST,1500)I,(YNOMVA(1,J),J=I,IMAX)
  226.             WRITE(JLST,1550)  (YNOMVA(2,J),J=I,IMAX)
  227.           WHEN , COMPLEX_32
  228.             WRITE(JLST,1500)I,(ZNOMVA(1,J),J=I,IMAX)
  229.             WRITE(JLST,1550)  (ZNOMVA(2,J),J=I,IMAX)
  230.           WHEN , CHARACTER
  231.             WRITE(JLST,1600)I
  232.      *     ,( HNOMVA(J) (1:MIN(11,LEN(HNOMVA(J)))),J=I,IMAX)
  233.           ENDCASE
  234.         ENDDO
  235.       ELSE
  236. C
  237. C VARIABLE SIMPLE
  238. C
  239.         CASE           ,KAS
  240.         WHEN , LOGICAL , LOGICAL_2 , LOGICAL_1
  241.           CASE           ,KAS
  242.           WHEN , LOGICAL
  243.             IF(LNOMVA(1)) THEN
  244.               TRADL(1)='TRUE '
  245.             ELSE
  246.               TRADL(1)='FALSE'
  247.             ENDIF
  248.           WHEN , LOGICAL_2
  249.             IF(MNOMVA(1)) THEN
  250.               TRADL(1)='TRUE '
  251.             ELSE
  252.               TRADL(1)='FALSE'
  253.             ENDIF
  254.           WHEN , LOGICAL_1
  255.             IF(NNOMVA(1)) THEN
  256.               TRADL(1)='TRUE '
  257.             ELSE
  258.               TRADL(1)='FALSE'
  259.             ENDIF
  260.           ENDCASE
  261.           WRITE(JLST,1250) TRADL(1)
  262.         WHEN , INTEGER , POINTEUR
  263.           WRITE(JLST,1350) INOMVA(1)
  264.         WHEN , INTEGER_2
  265.           WRITE(JLST,1350) JNOMVA(1)
  266.         WHEN , INTEGER_1
  267.           WRITE(JLST,1350) KNOMVA(1)
  268.         WHEN , REAL_4
  269.           WRITE(JLST,1450) RNOMVA(1)
  270.         WHEN , REAL_8
  271.           WRITE(JLST,1450) DNOMVA(1)
  272.         WHEN , REAL_16
  273.           WRITE(JLST,1450) QNOMVA(1)
  274.         WHEN , COMPLEX
  275.           WRITE(JLST,1550) CNOMVA(1,1)
  276.           WRITE(JLST,1550) CNOMVA(2,1)
  277.        WHEN , COMPLEX_16
  278.           WRITE(JLST,1550) YNOMVA(1,1)
  279.           WRITE(JLST,1550) YNOMVA(2,1)
  280.         WHEN , COMPLEX_32
  281.           WRITE(JLST,1550) ZNOMVA(1,1)
  282.           WRITE(JLST,1550) ZNOMVA(2,1)
  283.         WHEN , CHARACTER
  284.           WRITE(JLST,1650) HNOMVA(1) (1:MIN(11,LEN(HNOMVA(1))))
  285.         ENDCASE
  286.       ENDIF
  287.                                                                RETURN
  288. C
  289.  1050 FORMAT(/,1X,A,' CARACTERE*',I6:,' DIMENSION ',3(I12))
  290.  1100 FORMAT(/,1X,A:,' DIMENSION ',4(I12))
  291.  1150 FORMAT(/,1X,A,'*POINTEUR':,' DIMENSION ',4(I12))
  292.  1200 FORMAT(1X,I6,'*',5(2X,A5:))
  293.  1250 FORMAT(8X       ,2X,A5)
  294.  1300 FORMAT(1X,I6,'*',5(I12))
  295.  1350 FORMAT(8X       ,I12)
  296.  1400 FORMAT(1X,I6,'*',5(1PE12.4))
  297.  1450 FORMAT(8X       ,1PE12.4)
  298.  1500 FORMAT(1X,I6,'*',5(1PE12.4))
  299.  1550 FORMAT(8X,       5(1PE12.4))
  300.  1600 FORMAT(1X,I6,'*',5(2X,A11:))
  301.  1650 FORMAT(8X       ,2X,A11)
  302.       END
  303.  
  304.  

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