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    GOUNAND   25/07/16    21:15:04     12327          
  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. * SG MAJ jerr sinon le traceback se fait une instruction plus tard
  166.       jerr=MAX(IERR,IERGLB)
  167. C     IF( jerr.NE.0 .AND. MBFONC.EQ.0) THEN
  168.       IF( jerr.NE.0 .AND. IERPER.LE.2) THEN
  169.           IF(MBFONC.EQ.0) THEN
  170.              CALL TRBACK
  171.           ELSE
  172.              CALL ANABAC
  173.          ENDIF
  174.       ENDIF
  175.       NOMLU=0
  176.       IF ( IRAZ .LE. -1 .OR. jerr.NE.0)   THEN
  177.          IPTEM=-(IRAZ + 1)
  178.          if(jerr.ne.0) iptem=0
  179.          CALL RAZPIL
  180.       ENDIF
  182.       LECTAB=0
  183. C   RETASSER LA PILE DES REELS (TOUTES LES 30 FOIS)
  184. C       ICTAS=ICTAS+1
  185. C       IF (ICTAS.GT.10) THEN
  186.         CALL TASREE
  187. C         ICTAS=0
  188. C       ENDIF
  189. C  y a t -il une erreur sur les assistants ?
  190.        if (LODEFE) then
  191.           merres = ierres
  192.           segact merres
  193.           LLLERR = LOSIER
  194.           segdes merres
  195.           if ( LLLERR ) THEN
  196. C            il faut que les assistants vident les listes d'instructions
  197.             JG = nbesc
  198.             SEGINI MLENTI
  199.             DO i = 1 , nbesc
  200.               LECT(i) = 1
  201.             END DO
  202.             LOPREM = .TRUE.
  203. 9876        continue
  204.             NBINSS = 0
  205.             DO i = 1 , nbesc
  206.               if ( LECT(I) .EQ. 1 ) then
  207.                 MESINS = MESCL(I)
  208.                 if ( LOPREM ) then
  209.                   SEGACT MESINS*MOD
  210.                 else
  211.                   SEGACT MESINS*(MOD,ECR=1)
  212.                 end if
  213.                 if ( NBINS .EQ. 0 .AND. INSCOU .EQ. 0 ) THEN
  214.                   LECT(I) = 0
  215.                 else
  216.                   NBINSS = NBINSS + 1
  217.                 end if
  218.                 SEGDES MESINS*RECORD
  219.               end if
  220.             END DO
  221.             LOPREM = .FALSE.
  222.             IF ( NBINSS .NE. 0 ) GOTO 9876
  223.             SEGSUP MLENTI
  224. C            les assistants ont vide leur pile d'instructions
  225.             segact merres*mod
  226.             do jerr = 1, NBERR
  227.              if(liserr(1,jerr).ne.0) then
  228.               write(ioimp,*) ' ------------------------------'
  229.               write(ioimp,*) ' assistant :',liserr(3,jerr)
  230.               write(ioimp,*) ' erreur :',liserr(1,jerr)
  231.               MLMOTS = liserr(2,jerr)
  232.               call ooove1(mlmots,iret)
  233.               if(iret.eq.2) then
  234.               segact MLMOTS
  235.               write(ioimp,*) MOTS(1) (1:MOTS(/1))
  236.               write(ioimp,*) MOTS(2) (1:MOTS(/1))
  237.               segdes MLMOTS
  238.               write(ioimp,*) ' ------------------------------'
  239.               endif
  240.              endif
  241.             end do
  242.             NBERR = 0
  243.             LOSIER = .FALSE.
  244.             segdes merres
  245.             IERR  =0
  246.             IERGLB=0
  247.             CALL ERREUR (915)
  248.             RETURN
  249.           end if
  250.         if (LOTRMA) then
  251.           mesins = mescl(0)
  252.           segact mesins*mod
  253.           call nouins2
  254.         end if
  255.        end if
  256.        ierglb=ierr
  257.       RETURN
  258.       END
  259.  
  260.  

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