Télécharger la plaquette Cast3M


fr en

Télécharger selloi.eso

Retour à la liste

Numérotation des lignes : 

selloi

  1. C SELLOI    SOURCE    OF166741  25/10/03    21:15:06     12350          
  2.  
  3. *======================================================================*
  4. *
  5. *  OBJET :   Composante de type TABLE
  6. *  -------
  7. *  La TABLE donne le nom de la loi et les parametres de la composante,
  8. *  en fonction desquels doit se faire l'evaluation externe.
  9. *
  10. *  ENTREE :
  11. *  --------
  12. *    IPTABE   Pointeur sur la TABLE de definition de la LOI externe
  13. *             Le segment est DESACTIVE en Sortie (SEGDES)
  14. *
  15. *  SORTIE :
  16. *  --------
  17. *    IPTABS   Pointeur sur la TABLE preconditionnee
  18. *             < 0 ou = 0 si erreur lors de l'analyse
  19. *             Le segment est ACTIF en Sortie (SEGACT*NOMOD)
  20. *======================================================================*
  21.  
  22.       SUBROUTINE SELLOI(IPTABE,IPTABS,IRET)
  23.  
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCPRECO
  30. -INC CCNOYAU
  31.  
  32. -INC SMLMOTS
  33. -INC SMTABLE
  34.  
  35.       CHARACTER*(LOCHAI) MOTEMP,LMELIB,LMEFCT
  36.  
  37.       iimpi0 = IIMPI
  38. c*dbg      iimpi0 = 1972
  39.  
  40.       IPTABS = 0
  41.  
  42.       mtab1 = IPTABE
  43.  
  44. C- Recherche si la table IPTABE n'a pas deja ete traite :
  45. C- Verification si presence dans le preconditionnement "CLOIEX" (CCPRECO)
  46.       isloi = 0
  47.       DO is = 1, NBELOI
  48.         IF ( LOITAB(is).LE.0 ) GOTO 10
  49.         isloi = isloi + 1
  50.         IF ( mtab1 .EQ. LOITAB(is) ) THEN
  51.           mtab2 = LOIPRE(is)
  52.           if (iimpi0.eq.1972) then
  53.             write(ioimp,*) 'Preconditionnement SELLOI trouve',
  54.      &                     is,mtab1,mtab2
  55.           endif
  56. C       Mise a jour du preconditionnement dans CCPRECO : Deplacement en position 1
  57.           IF (is .GT. 1) THEN
  58.             DO js = is, 2, -1
  59.               LOITAB(js) = LOIPRE(js-1)
  60.               LOIPRE(js) = LOIPRE(js-1)
  61.             ENDDO
  62.             LOITAB(1) = mtab1
  63.             LOIPRE(1) = mtab2
  64.           ENDIF
  65.           SEGACT,mtab2*NOMOD
  66.           IPTABS = mtab2
  67.           GOTO 100
  68.         ENDIF
  69.       ENDDO
  70.  10   CONTINUE
  71.       if (iimpi0.eq.1972) then
  72.         write(ioimp,*) 'Preconditionnement SELLOI :',isloi,'/',NBELOI
  73.       endif
  74.  
  75. C- Verification du contenu de la table & Ajout au preconditionnement :
  76.       SEGACT,mtab1
  77.       IF (NBESC.NE.0) SEGACT,IPILOC
  78.  
  79.       ierloc = 0
  80. C- Recherche sur les noms
  81. C  Initialisation des indices
  82.       NPARA  = 0
  83.       MLMOT1 = 0
  84.       ITROU1 = 0
  85.       LMELIB = '                '
  86.       LMELGB = 0
  87.       LMEFCT = '                '
  88.       LMELGT = 0
  89.       LMEPTR = 0
  90.       LMELOI = 0
  91.       ITROU2 = 0
  92.       LMEPRO = 0
  93. C  Verification des types des indices correspondants
  94.       DO IN = 1, mtab1.MLOTAB
  95.         IF (mtab1.MTABTI(IN).EQ.'MOT') THEN
  96.           ip = mtab1.MTABII(IN)
  97.           IDEBCH = IPCHAR(ip)
  98.           IFINCH = IPCHAR(ip+1)-1
  99.           MOTEMP = ICHARA(IDEBCH:IFINCH)
  100. C     Liste des parametres de la loi
  101.           IF ((MOTEMP.EQ.'PARA_LOI' ) .OR.
  102.      &        (MOTEMP.EQ.'VARIABLES')) THEN
  103.             IF (mtab1.MTABTV(IN).EQ.'LISTMOTS') THEN
  104.               MLMOT1 = mtab1.MTABIV(IN)
  105.             ELSE
  106.               MLMOT1 = 0
  107.               IERR   = 0
  108.               IERGLB = 0
  109.               MOTERR = '        '
  110.               MOTERR( 1:11) = MOTEMP
  111.               MOTERR(12:19) = 'LISTMOTS'
  112.               CALL ERREUR(627)
  113.               ierloc = ierloc + 1
  114.             ENDIF
  115. C     Nom de la loi/fonction a utiliser dans la bibliotheque
  116.           ELSE IF ((MOTEMP.EQ.'FCT_LOI') .OR.
  117.      &             (MOTEMP.EQ.'MODELE' )) THEN
  118.             IF (mtab1.MTABTV(IN).EQ.'MOT    ') THEN
  119.               ip = mtab1.MTABIV(IN)
  120.               IDEBCH = IPCHAR(ip)
  121.               IFINCH = IPCHAR(ip+1)-1
  122.               LMELGT = IFINCH-IDEBCH+1
  123.               IF (LMELGT.LE.0 .OR. LMELGT.GT.LOCHAI) THEN
  124.                 IERR   = 0
  125.                 IERGLB = 0
  126.                 INTERR(1) = LMELGT
  127.                 MOTERR = ICHARA(IDEBCH:IFINCH)
  128.                 CALL ERREUR(-2)
  129.                 IERR   = 0
  130.                 IERGLB = 0
  131.                 CALL ERREUR(36)
  132.                 LMELGT = 0
  133.                 ierloc = ierloc + 1
  134.               ELSE
  135.                 LMEFCT = ICHARA(IDEBCH:IFINCH)
  136.                 ITROU1 = ITROU1+1
  137.               ENDIF
  138.             ELSE
  139.               IERR   = 0
  140.               IERGLB = 0
  141.               MOTERR = '        '
  142.               MOTERR( 1:11) = MOTEMP
  143.               MOTERR(12:19) = 'MOT     '
  144.               CALL ERREUR(627)
  145.               ierloc = ierloc + 1
  146.             ENDIF
  147. C     Nom de la bibliotheque ou se trouve la loi materiau
  148.           ELSE IF ((MOTEMP.EQ.'LIB_LOI  ') .OR.
  149.      &             (MOTEMP.EQ.'LIBRAIRIE')) THEN
  150.             IF (mtab1.MTABTV(IN).EQ.'MOT    ') THEN
  151.               ip = mtab1.MTABIV(IN)
  152.               IDEBCH = IPCHAR(ip)
  153.               IFINCH = IPCHAR(ip+1)-1
  154.               LMELGB = IFINCH-IDEBCH+1
  155.               IF (LMELGB.LE.0 .OR. LMELGB.GT.LOCHAI) THEN
  156.                 IERR   = 0
  157.                 IERGLB = 0
  158.                 INTERR(1) = LMELGB
  159.                 MOTERR = ICHARA(IDEBCH:IFINCH)
  160.                 CALL ERREUR(-2)
  161.                 IERR   = 0
  162.                 IERGLB = 0
  163.                 CALL ERREUR(36)
  164.                 LMELGT = 0
  165.                 ierloc = ierloc + 1
  166.               ELSE
  167.                 LMELIB = ICHARA(IDEBCH:IFINCH)
  168.                 ITROU1 = ITROU1+10
  169.               ENDIF
  170.             ELSE
  171.               IERR   = 0
  172.               IERGLB = 0
  173.               MOTERR = '        '
  174.               MOTERR( 1:11) = MOTEMP
  175.               MOTERR(12:19) = 'MOT     '
  176.               CALL ERREUR(627)
  177.               ierloc = ierloc + 1
  178.             ENDIF
  179. C     Nom du programme externe
  180.           ELSE IF (MOTEMP.EQ.'PROGRAMME') THEN
  181.             IF (mtab1.MTABTV(IN).EQ.'MOT    ') THEN
  182.               ip = mtab1.MTABIV(IN)
  183.               IDEBCH = IPCHAR(ip)
  184.               IFINCH = IPCHAR(ip+1)-1
  185.               LMEPRO = IFINCH-IDEBCH+1
  186.               IF (LMEPRO.LE.0 .OR. LMEPRO.GT.LOCHAI) THEN
  187.                 IERR   = 0
  188.                 IERGLB = 0
  189.                 INTERR(1) = LMEPRO
  190.                 MOTERR = ICHARA(IDEBCH:IFINCH)
  191.                 CALL ERREUR(-2)
  192.                 IERR   = 0
  193.                 IERGLB = 0
  194.                 CALL ERREUR(36)
  195.                 LMEPRO = 0
  196.                 ierloc = ierloc + 1
  197.               ELSE
  198.                 LMEPRO = ip
  199.                 ITROU2 = 1
  200.               ENDIF
  201.             ELSE
  202.               IERR   = 0
  203.               IERGLB = 0
  204.               MOTERR = '        '
  205.               MOTERR( 1:11) = MOTEMP
  206.               MOTERR(12:19) = 'MOT     '
  207.               CALL ERREUR(627)
  208.               ierloc = ierloc + 1
  209.             ENDIF
  210.           ENDIF
  211.         ENDIF
  212.       ENDDO
  213.       IF (ierloc.GT.0) GOTO 30
  214.  
  215. C Dernieres verifications de la table
  216.       IF (MLMOT1.EQ.0) THEN
  217.         MOTERR = 'ERROR: PARA_LOI missing'
  218.         CALL ERREUR(-385)
  219.         ierloc = ierloc + 1
  220.       ENDIF
  221.       IF ((ITROU1.EQ.0).AND.(ITROU2.EQ.0)) THEN
  222.         MOTERR = 'ERROR: PROGRAMME and LIB_LOI/FCT_LOI missing'
  223.         CALL ERREUR(-385)
  224.         ierloc = ierloc + 1
  225.       ENDIF
  226.       IF ((ITROU1.NE.0).AND.(ITROU2.NE.0)) THEN
  227.         MOTERR = 'ERROR: neither PROGRAMME nor LIB_LOI/FCT_LOI'
  228.         CALL ERREUR(-385)
  229.         ierloc = ierloc + 1
  230.         GOTO 30
  231.       ENDIF
  232.       IF (ITROU1.NE.0) THEN
  233.         IF (ITROU1.NE.11) THEN
  234.           MOTERR = 'ERROR: LIB_LOI or FCT_LOI missing'
  235.           CALL ERREUR(-385)
  236.           ierloc = ierloc + 1
  237.         ENDIF
  238.       ENDIF
  239.       IF (ierloc.GT.0) THEN
  240.         INTERR(1) = -3
  241.         CALL ERREUR(957)
  242.         GOTO 30
  243.       ENDIF
  244.  
  245.       SEGACT,MLMOT1
  246.       NPARA = MLMOT1.MOTS(/2)
  247.       SEGDES,MLMOT1
  248.       IF (ITROU1.NE.0) THEN
  249.         ip = NPARA
  250.         CALL LEXTOP(LMELIB,LMEFCT,ip,LMELOI,LMEPTR)
  251.         IF (IERR.NE.0) GOTO 30
  252.       ENDIF
  253.  
  254. C- Verification de la table reussie - Creation de la table preconditionnee :
  255.       M = 4
  256.       SEGINI,mtab2
  257.       mtab2.MLOTAB = M
  258.       mtab2.MTABTI(1) = 'ENTIER  '
  259.       mtab2.MTABII(1) = 0
  260.       mtab2.MTABTV(1) = 'ENTIER  '
  261.       IF (ITROU1.NE.0) THEN
  262.         mtab2.MTABIV(1) = 1
  263.       ELSE
  264.         mtab2.MTABIV(1) = 2
  265.       ENDIF
  266.       mtab2.MTABTI(2) = 'ENTIER  '
  267.       mtab2.MTABII(2) = 1
  268.       mtab2.MTABTV(2) = 'ENTIER  '
  269.       mtab2.MTABIV(2) = NPARA
  270.  
  271.       mtab2.MTABTI(3) = 'ENTIER  '
  272.       mtab2.MTABII(3) = 2
  273.       mtab2.MTABTV(3) = 'LISTMOTS'
  274.       mtab2.MTABIV(3) = MLMOT1
  275.  
  276.       mtab2.MTABTI(4) = 'ENTIER  '
  277.       mtab2.MTABII(4) = 3
  278.       IF (ITROU1.NE.0) THEN
  279.         mtab2.MTABTV(4) = 'ENTIER  '
  280.         mtab2.MTABIV(4) = LMEPTR
  281.       ELSE
  282.         mtab2.MTABTV(4) = 'MOT     '
  283.         mtab2.MTABIV(4) = LMEPRO
  284.       ENDIF
  285.       if (iimpi0.eq.1972) then
  286.         call ectabl(mtab2)
  287.       endif
  288.       SEGACT,mtab2*NOMOD
  289.  
  290. C- Ajout en position 1 dans le preconditionnement "CLOIEX" (CCPRECO)
  291.       if (isloi.eq.NBELOI) then
  292.         moterr = 'Warning "CLOIEX": maximum NBELOI atteint'
  293.         CALL ERREUR(-385)
  294.       end if
  295.       isloi = MIN(isloi + 1,NBELOI)
  296.       DO is = isloi, 2, -1
  297.         LOITAB(is) = LOIPRE(is-1)
  298.         LOIPRE(is) = LOIPRE(is-1)
  299.       ENDDO
  300.       LOITAB(1) = mtab1
  301.       LOIPRE(1) = mtab2
  302.       LOITAB(0) = isloi
  303.  
  304.       IPTABS = mtab2
  305.       if (iimpi0.eq.1972) then
  306.         write(ioimp,*) 'Preconditionnement SELLOI ',iptabe,iptabs,isloi
  307.       endif
  308.  
  309. C- Fin du traitement
  310.  30   CONTINUE
  311.       SEGDES,mtab1
  312.       if (NBESC.NE.0) SEGDES,IPILOC
  313.  100  CONTINUE
  314.  
  315. c      return
  316.       END
  317.  
  318.  
  319.  

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