Télécharger la plaquette Cast3M


fr en

Télécharger nuage.eso

Retour à la liste

Numérotation des lignes : 

nuage

  1. C NUAGE     SOURCE    CHAT      05/01/13    02:02:47     5004
  2.       SUBROUTINE NUAGE
  3.       IMPLICIT INTEGER(I-N)
  4.  
  5. -INC PPARAM
  6. -INC CCOPTIO
  7. -INC SMNUAGE
  8.       CHARACTER*8 NOM,ITYPE,NOP
  9.       CHARACTER*4 MO(2)
  10.       REAL*8 XIJ
  11.       LOGICAL LIJ
  12.       DATA MO/'COMP','*   '/
  13.       NVAR=0
  14.       NBCOUP=0
  15. *
  16. *  lecture dans le cas d'un champ par point
  17. *
  18.       CALL LIROBJ('CHPOINT', MCHPOI, 0, IRETOU)
  19.       IF (IERR .NE. 0) RETURN
  20.       IF (IRETOU .NE. 0) THEN
  21.          CALL NUACHP(MCHPOI)
  22.          GOTO 200
  23.       ENDIF
  24.       SEGINI MNUAGE
  25.       CALL LIRMOT ( MO,1,IVA,0)
  26.       IF(IVA.EQ.1) GO TO 50
  27. *
  28. *   lecture dans le cas d'un champ par élément
  29. *
  30.       CALL LIROBJ('MCHAML', MCHEML, 0, IRETOU)
  31.       IF (IERR .NE. 0) RETURN
  32.       IF (IRETOU .NE. 0) THEN
  33.           CALL NUACHL(MCHEML)
  34.           goto 200
  35.       ENDIF
  36.       SEGINI MNUAGE
  37.       CALL LIRMOT ( MO,1,IVA,0)
  38.       IF(IVA.EQ.1) GO TO 50
  39. *
  40. *  lecture n-uplets par n-uplets on commence par nom*type
  41. *
  42.   51  CONTINUE
  43. *      write(6,fmt='('' on passe par la '')')
  44.       CALL QUETYP(ITYPE,0,IRETOU)
  45. *      write(6,fmt='('' itype de quetyp '',a8)')itype
  46.       IF(IRETOU.EQ.0) GO TO 52
  47.       IF(ITYPE.NE.'MOT     ') GO TO 52
  48.       CALL LIRCHA( NOM,0,IRETOU)
  49. *      write(6,fmt='('' nom '',a8)')nom
  50.       CALL LIRMOT(MO(2),1,IVA,0)
  51. *      write(6,fmt='('' iva '',i8)')iva
  52.       IF(IVA.EQ.0) THEN
  53.         CALL ECRCHA( NOM)
  54.         GO TO 52
  55.       ENDIF
  56.       CALL LIRCHA(ITYPE,1,IRETOU)
  57. *      write(6,fmt='('' itype '',a8)')itype
  58.       IF(IERR.NE.0) GO TO 1000
  59.       NVAR=NVAR+1
  60.       SEGADJ MNUAGE
  61.       NUANOM( NVAR)=NOM
  62.       NUATYP(NVAR)=ITYPE
  63.       IF(ITYPE.EQ.'FLOTTANT') THEN
  64.           SEGINI NUAVFL
  65.           NUAPOI(NVAR)= NUAVFL
  66.       ELSEIF(ITYPE.EQ.'MOT     ') THEN
  67.           SEGINI NUAVMO
  68.           NUAPOI(NVAR)= NUAVMO
  69.       ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
  70.           SEGINI NUAVLO
  71.           NUAPOI(NVAR)= NUAVLO
  72.       ELSE
  73.           SEGINI NUAVIN
  74.           NUAPOI(NVAR)= NUAVIN
  75.       ENDIF
  76.       GO TO 51
  77.    52 CONTINUE
  78.       DO 53 K=1,NVAR
  79.       ITYPE= NUATYP(K)
  80.       IF(K.EQ.1) NBCOUP=NBCOUP+1
  81.       ICODE=0
  82.       IF(K.NE.1) ICODE=1
  83.       IF(ITYPE.EQ.'FLOTTANT') THEN
  84.           CALL LIRREE( XIJ,ICODE,IRETOU)
  85.           IF( IERR.NE.0) GO TO 1000
  86.           IF( IRETOU.EQ.0) GO TO 54
  87.               NUAVFL=NUAPOI(K)
  88.               SEGADJ NUAVFL
  89.               NUAFLO(NBCOUP)=XIJ
  90.       ELSEIF(ITYPE.EQ.'MOT     ') THEN
  91.           CALL LIRCHA(NOP,ICODE,IRETOU)
  92.           IF( IERR.NE.0) GO TO 1000
  93.           IF( IRETOU.EQ.0) GO TO 54
  94.               NUAVMO=NUAPOI(K)
  95.               SEGADJ NUAVMO
  96.               NUAMOT(NBCOUP)=NOP
  97.       ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
  98.           CALL LIRLOG(LIJ,ICODE,IRETOU)
  99.           IF( IERR.NE.0) GO TO 1000
  100.           IF( IRETOU.EQ.0) GO TO 54
  101.               NUAVLO=NUAPOI(K)
  102.               SEGADJ NUAVLO
  103.               NUALOG(NBCOUP)=LIJ
  104.       ELSEIF(ITYPE.EQ.'ENTIER  ') THEN
  105.           CALL LIRENT(IJ,ICODE,IRETOU)
  106.           IF( IERR.NE.0) GO TO 1000
  107.           IF( IRETOU.EQ.0) GO TO 54
  108.               NUAVIN=NUAPOI(K)
  109.               SEGADJ NUAVIN
  110.               NUAINT(NBCOUP)=IJ
  111.       ELSE
  112.           CALL LIROBJ(ITYPE,IJ,ICODE,IRETOU)
  113.           IF( IERR.NE.0) GO TO 1000
  114.           IF( IRETOU.EQ.0) GO TO 54
  115.               NUAVIN=NUAPOI(K)
  116.               SEGADJ NUAVIN
  117.               NUAINT(NBCOUP)=IJ
  118.       ENDIF
  119.    53 CONTINUE
  120.       GO TO 52
  121.    54 CONTINUE
  122.       DO 55 IJ=1,NVAR
  123.       ITYPE=NUATYP(IJ)
  124.       IF(ITYPE.EQ.'FLOTTANT') THEN
  125.          NUAVFL=NUAPOI(IJ)
  126.          SEGDES NUAVFL
  127.       ELSEIF(ITYPE.EQ.'MOT     ') THEN
  128.          NUAVMO=NUAPOI(IJ)
  129.          SEGDES NUAVMO
  130.       ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
  131.          NUAVLO=NUAPOI(IJ)
  132.          SEGDES NUAVLO
  133.       ELSE
  134.          NUAVIN=NUAPOI(IJ)
  135.          SEGDES NUAVIN
  136.       ENDIF
  137.    55 CONTINUE
  138.       SEGDES MNUAGE
  139.       CALL ECROBJ('NUAGE   ',MNUAGE)
  140.       RETURN
  141. *
  142. *     lecture par definition composantes par composantes
  143. *
  144.     1 CONTINUE
  145.       CALL LIRMOT ( MO,1,IVA,0)
  146.       IF( IVA.EQ.0)   THEN
  147.         IF(NVAR.EQ.0) THEN
  148.            CALL ERREUR(626)
  149.            SEGSUP MNUAGE
  150.         ELSE
  151.            SEGDES MNUAGE
  152.            CALL ECROBJ('NUAGE   ',MNUAGE)
  153.         ENDIF
  154.         RETURN
  155.       ENDIF
  156.   50  CONTINUE
  157.       CALL LIRCHA( NOM,0,IRETOU)
  158.       IF( IRETOU.EQ.0) THEN
  159.         IF(NVAR.EQ.0) CALL ERREUR(6)
  160.         SEGSUP MNUAGE
  161.         RETURN
  162.       ENDIF
  163.       NVAR=NVAR + 1
  164.       SEGADJ MNUAGE
  165.       CALL  QUETYP (ITYPE,1, IRETOU)
  166.       IF(IERR.NE.0) THEN
  167.          SEGSUP MNUAGE
  168.          RETURN
  169.       ENDIF
  170.       NUANOM( NVAR)=NOM
  171.       NUATYP(NVAR)=ITYPE
  172.       NLU=0
  173.       IF(ITYPE.EQ.'FLOTTANT') THEN
  174.           SEGINI NUAVFL
  175.           NUAPOI(NVAR)= NUAVFL
  176.       ELSEIF(ITYPE.EQ.'MOT     ') THEN
  177.           SEGINI NUAVMO
  178.           NUAPOI(NVAR)= NUAVMO
  179.       ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
  180.           SEGINI NUAVLO
  181.           NUAPOI(NVAR)= NUAVLO
  182.       ELSE
  183.           SEGINI NUAVIN
  184.           NUAPOI(NVAR)= NUAVIN
  185.       ENDIF
  186.     2 CONTINUE
  187.       IF(ITYPE.EQ.'FLOTTANT') THEN
  188.         CALL LIRREE( XIJ,0,IRETOU)
  189.         IF( IRETOU.EQ.0) GO TO 10
  190.         NLU=NLU+1
  191.         IF(NLU.GT.NBCOUP) THEN
  192.           IF(NVAR.NE.1) GO TO 1000
  193.           NBCOUP=NBCOUP+20
  194.           SEGADJ NUAVFL
  195.         ENDIF
  196.         NUAFLO(NLU)=XIJ
  197.       ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
  198.         CALL LIRLOG(LIJ,0,IRETOU)
  199.         IF( IRETOU.EQ.0) GO TO 10
  200.         NLU=NLU+1
  201.         IF(NLU.GT.NBCOUP) THEN
  202.           IF(NVAR.NE.1) GO TO 1000
  203.           NBCOUP=NBCOUP+20
  204.           SEGADJ NUAVLO
  205.         ENDIF
  206.         NUALOG(NLU)=LIJ
  207.       ELSEIF(ITYPE.EQ.'MOT     ') THEN
  208.         CALL LIRCHA(NOP,0,IRETOU)
  209.         IF( IRETOU.EQ.0) GO TO 10
  210.         IF( NOP(1:4).EQ.'COMP')THEN
  211.             CALL REFUS
  212.             GO TO 10
  213.         ENDIF
  214.         NLU=NLU+1
  215.         IF(NLU.GT.NBCOUP) THEN
  216.           IF(NVAR.NE.1)    GO TO 1000
  217.           NBCOUP=NBCOUP+20
  218.           SEGADJ NUAVMO
  219.         ENDIF
  220.         NUAMOT(NLU)=NOP
  221.       ELSEIF(ITYPE.EQ.'ENTIER  ') THEN
  222.         CALL LIRENT(IJ,0,IRETOU)
  223.         IF( IRETOU.EQ.0) GO TO 10
  224.         NLU=NLU+1
  225.         IF(NLU.GT.NBCOUP) THEN
  226.           IF(NVAR.NE.1) GO TO 1000
  227.           NBCOUP=NBCOUP+20
  228.           SEGADJ NUAVIN
  229.         ENDIF
  230.         NUAINT(NLU)=IJ
  231.       ELSE
  232.         CALL LIROBJ(ITYPE,IRET,0,IRETOU)
  233.         IF( IRETOU.EQ.0) GO TO 10
  234.         NLU=NLU+1
  235.         IF(NLU.GT.NBCOUP) THEN
  236.           IF(NVAR.NE.1) GO TO 1000
  237.           NBCOUP=NBCOUP+20
  238.           SEGADJ NUAVIN
  239.         ENDIF
  240.         NUAINT(NLU)=IRET
  241.       ENDIF
  242.       GO TO 2
  243.   10  CONTINUE
  244.       IF( NVAR.EQ.1) THEN
  245.          IF(NLU.NE.NBCOUP)  THEN
  246.            NBCOUP=NLU
  247.            IF(ITYPE.EQ.'FLOTTANT') THEN
  248.              SEGADJ NUAVFL
  249.            ELSEIF(ITYPE.EQ.'MOT     ') THEN
  250.              SEGADJ NUAVMO
  251.            ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
  252.              SEGADJ NUAVLO
  253.            ELSE
  254.              SEGADJ NUAVIN
  255.            ENDIF
  256.          ENDIF
  257.       ELSE
  258.          IF( NBCOUP.NE.NLU) GO TO 1000
  259.       ENDIF
  260.       IF(ITYPE.EQ.'FLOTTANT') THEN
  261.         SEGDES NUAVFL
  262.       ELSEIF(ITYPE.EQ.'MOT     ') THEN
  263.         SEGDES NUAVMO
  264.       ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
  265.         SEGDES NUAVLO
  266.       ELSE
  267.         SEGDES NUAVIN
  268.       ENDIF
  269.       GO TO 1
  270. 1000  continue
  271.       CALL ERREUR(625)
  272.       DO 11 IJ=1,NVAR
  273.          ITYPE= NUATYP(IJ)
  274.          IF(ITYPE.EQ.'FLOTTANT') THEN
  275.              NUAVFL=NUAPOI(IJ)
  276.              SEGSUP NUAVFL
  277.          ELSEIF(ITYPE.EQ.'MOT     ') THEN
  278.              NUAVMO=NUAPOI(IJ)
  279.              SEGSUP NUAVMO
  280.          ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
  281.              NUAVLO=NUAPOI(IJ)
  282.              SEGSUP NUAVLO
  283.          ELSE
  284.              NUAVIN=NUAPOI(IJ)
  285.              SEGSUP NUAVIN
  286.          ENDIF
  287.       SEGSUP MNUAGE
  288.   11  CONTINUE
  289.  200  CONTINUE
  290.       RETURN
  291.       END
  292.  
  293.  
  294.  
  295.  

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