Télécharger la plaquette Cast3M


fr en

Télécharger nouins.eso

Retour à la liste

Numérotation des lignes : 

nouins

  1. C NOUINS    SOURCE    CB215821  24/07/17    21:15:13     11961          
  2. C    SERT A DONNER LES NOMS INDIQUES AUX OBJETS SE TROUVANT DANS LA PILE
  3. C
  4.        SUBROUTINE NOUINS
  5.  
  6.       IMPLICIT INTEGER(I-N)
  7.  
  8. -INC PPARAM
  9. -INC CCNOYAU
  10. -INC CCOPTIO
  11. -INC SMBLOC
  12. -INC SMLMOTS
  13. -INC SMLENTI
  14. -INC CCASSIS
  15. C
  16.       CHARACTER*(8) ITBNO,ITCH
  17.       CHARACTER*(32) ITCH2
  18.       CHARACTER*(LONOM) CNOM
  19.       LOGICAL LLLERR , LOPREM , LOERAS, BOOL1
  20.       REAL*8 XVAL
  21.  
  22.  
  23. C     On positionne JERR au MAXI entre l'erreur par ASSISTANT et l'erreur GLOBALE
  24.       jerr=MAX(IERR,IERGLB)
  25.  
  26.       IF (INTEMP.EQ.0)GO TO 10
  27.       IF(jerr.GT.1) GO TO 20
  28. C  ON AFFECTE UN OBJET TEMPORAIRE EVENTUEL
  29.       IRETTP=0
  30.       CALL QUETYP(ITCH,0,IRETTP)
  31.       IF(IRETTP.EQ.0) THEN
  32.          ITBNOM=ITANO1(1)
  33.          INOOB2(ITBNOM)=' '
  34.          IOUEP2(ITBNOM)=0
  35.          GO TO 20
  36.       ENDIF
  37.       CALL LIROBJ(ITCH,IRET,1,IRETTP)
  38.       IF (IRETTP.EQ.0) THEN
  39.         CALL ERREUR(5)
  40.       ENDIF
  41.       ITBNOM=ITANO1(1)
  42.       INOOB2(ITBNOM)=JTYOBJ(IMOTLU)
  43.       IOUEP2(ITBNOM)=JPOOB4(IMOTLU)
  44.       ISSPOT=ISPOTE
  45.       IIPOTE=IIPOTE+1
  46.       IF ( IIPOTE.GT. IPOTEM(/1)) THEN
  47. C          write (6,*)'**************************************'
  48. C          write (6,*) 'necessite dagrandir iipote ' , iipote
  49. C          write (6,*)'**************************************'
  50.         NVQTEM=IPOTEM(/1)+20
  51.         SEGADJ ISSPOT
  52.       ENDIF
  53.       IPOTEM(IIPOTE) = ITBNOM
  54.       GOTO 100
  55.   10  CONTINUE
  56. C  ON PREND LES NOMS LES UNS APRES LES AUTRES
  57.       INOM=0
  58.  
  59.   11  CONTINUE
  60.       INOM=INOM+1
  61.       IF (INOM.GT.NBNOM) GOTO 100
  62.       if(nbesc.ne.0) segact ipiloc
  63.       IRET=0
  64.       ITBNOM=ITANO1(INOM)
  65.       ITCHA=INOOB1(ITBNOM)
  66.       IDEBCH=IPCHAR(ITCHA)
  67.       IFINCH=IPCHAR(ITCHA+1)-1
  68.       MOTERR(1:8)=ICHARA(IDEBCH:IFINCH)
  69.       CALL MESLIR(-183)
  70.       ITCH=ITANOM(INOM)
  71.       if(nbesc.ne.0)SEGDES,IPILOC
  72.       call lirabj('PROCEDUR',iret,0,iretou)
  73.       if(Iretou.ne.0) then
  74.         itch='PROCEDUR'
  75.       else
  76.       CALL LIRABJ(ITCH,IRET,1,IRETOU)
  77.       endif
  78. C       write(6,*) ' itch iret ' , itch , iret
  79.       IF (INOM.NE.NBNOM) THEN
  80.          IF (INOOB2(ITBNOM).EQ.'TABLE   '.OR.INOOB2(ITBNOM).EQ.
  81.      $   'METHODOL' ) THEN
  83.             IF(INOOB2(ITBNOM).EQ.'METHODOL') ISUCC=1
  84. C  VEUT-ON REMPLIR UN ELEMENT D'UNE TABLE?
  85.  
  86.             CALL NTATAB ( INOM,ITCH,IRET,ISUCC)
  87.             if(nbesc.ne.0) segact ipiloc
  88.             IF(ISUCC.EQ.1)GOTO 11
  89.          ENDIF
  90.       ENDIF
  91. 12    CONTINUE
  92.       if(nbesc.ne.0) segact ipiloc
  93.       IF (ITBNOM.LE.0) CALL ERREUR(315)
  94.       IDEBCH=IPCHAR(ITCHA)
  95.       IFINCH=IPCHAR(ITCHA+1)-1
  96.       ITCH=ICHARA(IDEBCH:IFINCH)
  97.       if(nbesc.ne.0)SEGDES,IPILOC
  98.       IF (jerr.LE.1) THEN
  99.              IF( ITCH .EQ.' ') THEN
  100.                  CALL ERREUR(315)
  101.                  GO TO 20
  102.              ENDIF
  103.              IF( ITCH .EQ.'.') THEN
  104.                  CALL ERREUR(315)
  105.                  GO TO 20
  106.              ENDIF
  107.              IF(ITCH(1:1).EQ.'#') THEN
  108.                  CALL ERREUR(315)
  109.                  GO TO 20
  110.              ENDIF
  111.              INOOB2(ITBNOM)=JTYOBJ(IMOTLU)
  112.              IOUEP2(ITBNOM)=JPOOB4(IMOTLU)
  113.       ELSE
  114.              IF(ITCH .NE.'.'.AND.ITCH.NE.
  115.      $       ' ') INOOB2(ITBNOM)='ANNULE  '
  116.       ENDIF
  117.       GOTO 11
  118.  100  CONTINUE
  119.  
  120. C  VERIFIER QU'IL N'Y A PAS D'OBJET DANS LA PILE
  121.       IF(jerr.NE.0) GOTO 20
  122.       CALL QUETYP(ITCH,0,IRETOU)
  123.       IF (IRETOU.EQ.0) GOTO 20
  124.       MOTERR(1:8)=ITCH
  125.       IF (ITCH .EQ. 'MOT     ') THEN
  126.         CALL LIRCHA(ITCH,1,IRETOU)
  127.         ITCH2=ITCH
  128.         CALL QUENOM(CNOM)
  129.         IF (CNOM.EQ.' ') THEN
  130.           CNOM=ITCH2
  131.         ENDIF
  132.       ELSEIF (ITCH .EQ. 'ENTIER  ') THEN
  133.         CALL LIRENT(IVAL,1,IRETOU)
  134.         WRITE(ITCH2, '(i32)') IVAL
  135.         CALL QUENOM(CNOM)
  136.         IF (CNOM.EQ.' ') THEN
  137.           CNOM=ITCH2
  138.         ENDIF
  139.       ELSEIF (ITCH .EQ. 'FLOTTANT') THEN
  140.         CALL LIRREE(XVAL,1,IRETOU)
  141.         WRITE(ITCH2, '(F32.2)') XVAL
  142.         CALL QUENOM(CNOM)
  143.         IF (CNOM.EQ.' ') THEN
  144.           CNOM=ITCH2
  145.         ENDIF
  146.       ELSEIF (ITCH .EQ. 'LOGIQUE ') THEN
  147.         CALL LIRLOG(BOOL1,1,IRETOU)
  148.         IF (BOOL1) THEN
  149.           ITCH2='VRAI    '
  150.         ELSE
  151.           ITCH2='FAUX    '
  152.         ENDIF
  153.         CALL QUENOM(CNOM)
  154.         IF (CNOM.EQ.' ') THEN
  155.           CNOM=ITCH2
  156.         ENDIF
  157.       ELSE
  158.         CALL LIRABJ(ITCH,IRET,1,IRETOU)
  159.         CALL QUENOM(CNOM)
  160.       ENDIF
  161.       MOTERR(9:8+LONOM)=CNOM
  162.       CALL ERREUR(11)
  163.  
  164.   20  CONTINUE
  165. C     IF( jerr.NE.0 .AND. MBFONC.EQ.0) THEN
  166.       IF( jerr.NE.0 .AND. IERPER.LE.2) THEN
  167.           IF(MBFONC.EQ.0) THEN
  168.              CALL TRBACK
  169.           ELSE
  170.              CALL ANABAC
  171.          ENDIF
  172.       ENDIF
  173.       NOMLU=0
  174.       IF ( IRAZ .LE. -1 .OR. jerr.NE.0)   THEN
  175.          IPTEM=-(IRAZ + 1)
  176.          if(jerr.ne.0) iptem=0
  177.          CALL RAZPIL
  178.       ENDIF
  180.       LECTAB=0
  181. C   RETASSER LA PILE DES REELS (TOUTES LES 30 FOIS)
  182. C       ICTAS=ICTAS+1
  183. C       IF (ICTAS.GT.10) THEN
  184.         CALL TASREE
  185. C         ICTAS=0
  186. C       ENDIF
  187. C  y a t -il une erreur sur les assistants ?
  188.        if (LODEFE) then
  189.           merres = ierres
  190.           segact merres
  191.           LLLERR = LOSIER
  192.           segdes merres
  193.           if ( LLLERR ) THEN
  194. C            il faut que les assistants vident les listes d'instructions
  195.             JG = nbesc
  196.             SEGINI MLENTI
  197.             DO i = 1 , nbesc
  198.               LECT(i) = 1
  199.             END DO
  200.             LOPREM = .TRUE.
  201. 9876        continue
  202.             NBINSS = 0
  203.             DO i = 1 , nbesc
  204.               if ( LECT(I) .EQ. 1 ) then
  205.                 MESINS = MESCL(I)
  206.                 if ( LOPREM ) then
  207.                   SEGACT MESINS*MOD
  208.                 else
  209.                   SEGACT MESINS*(MOD,ECR=1)
  210.                 end if
  211.                 if ( NBINS .EQ. 0 .AND. INSCOU .EQ. 0 ) THEN
  212.                   LECT(I) = 0
  213.                 else
  214.                   NBINSS = NBINSS + 1
  215.                 end if
  216.                 SEGDES MESINS*RECORD
  217.               end if
  218.             END DO
  219.             LOPREM = .FALSE.
  220.             IF ( NBINSS .NE. 0 ) GOTO 9876
  221.             SEGSUP MLENTI
  222. C            les assistants ont vide leur pile d'instructions
  223.             segact merres*mod
  224.             do jerr = 1, NBERR
  225.              if(liserr(1,jerr).ne.0) then
  226.               write(ioimp,*) ' ------------------------------'
  227.               write(ioimp,*) ' assistant :',liserr(3,jerr)
  228.               write(ioimp,*) ' erreur :',liserr(1,jerr)
  229.               MLMOTS = liserr(2,jerr)
  230.               call ooove1(mlmots,iret)
  231.               if(iret.eq.2) then
  232.               segact MLMOTS
  233.               write(ioimp,*) MOTS(1) (1:MOTS(/1))
  234.               write(ioimp,*) MOTS(2) (1:MOTS(/1))
  235.               segdes MLMOTS
  236.               write(ioimp,*) ' ------------------------------'
  237.               endif
  238.              endif
  239.             end do
  240.             NBERR = 0
  241.             LOSIER = .FALSE.
  242.             segdes merres
  243.             IERR  =0
  244.             IERGLB=0
  245.             CALL ERREUR (915)
  246.             RETURN
  247.           end if
  248.         if (LOTRMA) then
  249.           mesins = mescl(0)
  250.           segact mesins*mod
  251.           call nouins2
  252.         end if
  253.        end if
  254.        ierglb=ierr
  255.       RETURN
  256.       END
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  

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