Télécharger la plaquette Cast3M


fr en

Télécharger excha1.eso

Retour à la liste

Numérotation des lignes : 

excha1

  1. C EXCHA1    SOURCE    PASCAL    21/09/16    21:15:01     11103          
  2.        SUBROUTINE EXCHA1(ICHAM,ILISR,CMOT)
  3.  
  4. ************************************************************************
  5. *
  6. *     EXTRACTION DES VARIABLES DONT DEPENDENT LES PARAMETRES DU
  7. *     MATERIAU.
  8. *
  9. *     ICHAM      (E)    INTEGER   POINTEUR SUR LE MCHAML
  10. *     ILISR      (S)    INTEGER   POINTEUR SUR UN OBJET DE TYPE SMLMOTS
  11. *                                 CONTENANT LES NOMS DES VARIABLES
  12. *     CMOT       (E)
  13. *
  14. ************************************************************************
  15.  
  16.       IMPLICIT INTEGER(I-N)
  17.       IMPLICIT REAL*8(A-H,O-Z)
  18.  
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC CCNOYAU
  23. -INC CCASSIS
  24.  
  25. -INC SMCHAML
  26. -INC SMLMOTS
  27. -INC SMNUAGE
  28. -INC SMEVOLL
  29. -INC SMTABLE
  30. c cccccc
  31.        PARAMETER ( NNOMCH=29 )
  32. c cccccc
  33.        CHARACTER*(*) CMOT
  34.        CHARACTER*8 NOMVXT,NOMVYT
  35.        CHARACTER*(LOCOMP) NOMCHT,LNOMCH(NNOMCH)
  36.        CHARACTER*4 MOTSIM
  37.        DATA MOTSIM / 'SIMU' /
  38.        DATA LNOMCH / 'TRAC    ','EVOL    ','COMP    ','FLXY    ',
  39.      &               'FLXZ    ','CISY    ','CISZ    ','JDA     ',
  40.      &               'EM0     ','EM1     ','EM2     ','EM3     ',
  41.      &               'EM4     ','EM5     ','EM6     ','EM7     ',
  42.      &               'EM8     ','MONP    ','MONN    ','MONO    ',
  43.      &               'COEV    ','TREV    ','TRAS    ','TRAT    ',
  44.      $               'PULO    ','ECRO    ','SJCB    ','SJTB    ',
  45.      $               'SJSB    '/
  46.       ICAS = 1
  47.       IF (CMOT.EQ.'COVA') ICAS = 2
  48.  
  49. *------------- activation de la liste de MOTS ------------------------
  50.  
  51.        JGM = 20
  52.        JGN = LOCOMP
  53.        SEGINI MLMOT1
  54.        ITE1 = 0
  55.  
  56.        MCHELM = ICHAM
  57.        NSOUS  = ICHAML(/1)
  58.  
  59. *------------------ boucle sur les sous chamelem ---------------------
  60.  
  61.        DO 1 I1=1,NSOUS
  62.           MCHAML = ICHAML(I1)
  63.           NCOMP = NOMCHE(/2)
  64.  
  65. *-------------------- boucle sur les composantes ---------------------
  66.  
  67.           DO 2 I2=1,NCOMP
  68.              IF      (TYPCHE(I2).EQ.'REAL*8          ') THEN
  69.                 GOTO 2
  70.              ELSE IF (TYPCHE(I2).EQ.'POINTEURPOINT   ') THEN
  71.                 GOTO 2
  72.              ELSE IF (TYPCHE(I2).EQ.'POINTEURMAILLAGE') THEN
  73.                 GOTO 2
  74.              ELSE IF (TYPCHE(I2).EQ.'POINTEURMCHAML  ') THEN
  75.                 GOTO 2
  76.              ELSE IF (TYPCHE(I2).EQ.'POINTEURCHPOINT ') THEN
  77.                 GOTO 2
  78.              ELSE IF (TYPCHE(I2).EQ.'POINTEURMMODEL  ') THEN
  79.                 GOTO 2
  80.              ELSE IF (TYPCHE(I2).EQ.'POINTEURLISTREEL') THEN
  81.                 GOTO 2
  82.              ELSE IF (TYPCHE(I2).EQ.'POINTEURNUAGE   ') THEN
  83.                 NOMCHT = NOMCHE(I2)
  84.                 IF (ICAS.EQ.1) THEN
  85.                   CALL PLACE(LNOMCH,NNOMCH,iplac,NOMCHT)
  86.                   MELVAL = IELVAL(I2)
  87. C                 SEGACT MELVAL
  88.                   NOE = IELCHE(/1)
  89.                   NEL = IELCHE(/2)
  90.                   DO 3 I3=1,NEL
  91.                     DO 4 I4=1,NOE
  92.                       MNUAGE = IELCHE(I4,I3)
  93.                       IF (MNUAGE.EQ.0) THEN
  94.                         MOTERR(1:8) = 'MCHAML' 
  95.                         INTERR = MCHAML
  96.                         CALL ERREUR(356)
  97.                         RETURN
  98.                       ENDIF
  99.                       SEGACT MNUAGE
  100.                       NVAR = NUANOM(/2)
  101.                       IPOSI = 0
  102.                       DO 5 I5 = 1,NVAR
  103.                         IF (NUANOM(I5).EQ.NOMCHT) IPOSI = I5
  104.   5                   CONTINUE
  105.                       IF (IPOSI.NE.0) THEN
  106.                          DO 6 I6 = 1,NVAR
  107.                             IF (I6.EQ.IPOSI) THEN
  108.                               IF (iplac.EQ.0) THEN
  109.                                IF (NUATYP(I6).EQ.'EVOLUTIO') THEN
  110.                                 NUAVIN=NUAPOI(I6)
  111.                                 SEGACT NUAVIN
  112.                                 MEVOL1=NUAINT(1)
  113. C                                SEGDES NUAVIN
  114.                                 SEGACT MEVOL1
  115.                                 N1=MEVOL1.IEVOLL(/1)
  116. C
  117. C  ON TESTE L'OBJET EVOLUTION
  118. C
  119.                                 IF(N1.NE.1) THEN
  120.                                   MOTERR(1:8)='EVOLUTIO'
  121.                                   INTERR(1)=MEVOL1
  122.                                   CALL ERREUR(110)
  123. C                                  SEGDES MEVOL1
  124. C                                  SEGDES MNUAGE
  125. C                                  SEGDES MELVAL
  126. C                                  SEGDES MCHAML
  127.                                   GOTO 9000
  128.                                 ENDIF
  129.                                 IF(MEVOL1.ITYEVO.NE.'REEL') THEN
  130.                                   MOTERR(1:8)='EVOLUTIO'
  131.                                   MOTERR(9:16)='REEL    '
  132.                                   CALL ERREUR(79)
  133. C                                  SEGDES MEVOL1
  134. C                                  SEGDES MNUAGE
  135. C                                  SEGDES MELVAL
  136. C                                  SEGDES MCHAML
  137.                                   GOTO 9000
  138.                                 ENDIF
  139.                                 KEVOL1=MEVOL1.IEVOLL(1)
  140. C                                SEGDES MEVOL1
  141.                                 SEGACT KEVOL1
  142.                                 IF(KEVOL1.TYPX.NE.'LISTREEL'.OR.
  143.      &                             KEVOL1.TYPY.NE.'LISTREEL')THEN
  144.                                   MOTERR(1:8)='EVOLUTIO'
  145.                                   MOTERR(9:16)='LISTREEL'
  146.                                   INTERR(1)=MEVOL1
  147.                                   CALL ERREUR(630)
  148. C                                  SEGDES KEVOL1
  149. C                                  SEGDES MNUAGE
  150. C                                  SEGDES MELVAL
  151. C                                  SEGDES MCHAML
  152.                                   GOTO 9000
  153.                                 ENDIF
  154.                                 NOMVXT=KEVOL1.NOMEVX(1:8)
  155. C                                SEGDES KEVOL1
  156.                                 DO 7 IU=1,ITE1
  157.                                   IF (MLMOT1.MOTS(IU).EQ.NOMVXT) GOTO 8
  158.   7                             CONTINUE
  159.                                 ITE1 = ITE1 + 1
  160.                                 IF (ITE1.GT.JGM) THEN
  161.                                   JGM = JGM + 20
  162.                                   SEGADJ MLMOT1
  163.                                 ENDIF
  164.                                 MLMOT1.MOTS(ITE1) = NOMVXT
  165.   8                             CONTINUE
  166.                                ENDIF
  167.                               ENDIF
  168.                             ELSE
  169.                               NOMVXT = NUANOM(I6)
  170.                               DO 9 IU=1,ITE1
  171.                                 IF (MLMOT1.MOTS(IU).EQ.NOMVXT) GOTO 10
  172.   9                           CONTINUE
  173.                               ITE1 = ITE1 + 1
  174.                               IF (ITE1.GT.JGM) THEN
  175.                                 JGM = JGM + 20
  176.                                 SEGADJ MLMOT1
  177.                               ENDIF
  178.                               MLMOT1.MOTS(ITE1) = NOMVXT
  179.  10                           CONTINUE
  180.                             ENDIF
  181.   6                      CONTINUE
  182.                       ELSE IF (nvar.gt.2) THEN
  183.                        goto 1
  184.                       ELSE
  185. *--------- un parametre du mchaml ne correspond a aucun -----------
  186. *------------------- nom de composante du NUAGE ---------------------
  187.                          MOTERR(1:8) = NOMCHT
  188.                          CALL ERREUR(677)
  189. C                         SEGDES MNUAGE
  190. C                         SEGDES MELVAL
  191. C                         SEGDES MCHAML
  192.                          GOTO 9000
  193.                       ENDIF
  194. C                      SEGDES MNUAGE
  195.   4                 CONTINUE
  196.   3               CONTINUE
  197. C                  SEGDES MELVAL
  198.                 ELSE IF (ICAS.EQ.2) THEN
  199.                   DO 11 IU=1,ITE1
  200.                     IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 12
  201.  11               CONTINUE
  202.                   ITE1 = ITE1+1
  203.                   IF (ITE1.GT.JGM) THEN
  204.                      JGM= JGM+20
  205.                      SEGADJ MLMOT1
  206.                   ENDIF
  207.                   MLMOT1.MOTS(ITE1) = NOMCHT
  208.  12               CONTINUE
  209.                 ENDIF
  210.  
  211.              ELSE IF (TYPCHE(I2).EQ.'POINTEUREVOLUTIO') THEN
  212.                 NOMCHT = NOMCHE(I2)
  213.                 CALL PLACE(LNOMCH,NNOMCH,iplac,NOMCHT)
  214.                 IF (iplac.NE.0) GOTO 2
  215.                 IF (ICAS.EQ.1) THEN
  216.                   MELVAL = IELVAL(I2)
  217.                   NOE = IELCHE(/1)
  218.                   NEL = IELCHE(/2)
  219.                   DO 13 I13=1,NEL
  220.                     DO 14 I14=1,NOE
  221.                       MEVOLL = IELCHE(I14,I13)
  222.                       IF (MEVOLL.EQ.0) THEN
  223.                         MOTERR(1:8) = 'MCHAML' 
  224.                         INTERR = MCHAML
  225.                         CALL ERREUR(356)
  226.                         RETURN
  227.                       ENDIF
  228.                       KEVOLL = IEVOLL(1)
  229.                       IF (KEVOLL.EQ.0) THEN
  230.                         MOTERR(1:8) = 'MCHAML' 
  231.                         INTERR = MCHAML
  232.                         CALL ERREUR(356)
  233.                         RETURN
  234.                       ENDIF
  235.                       NOMVYT=NOMEVY(1:8)
  236.                       IF (NOMCHT.EQ.NOMVYT) THEN
  237.                          NOMVXT=NOMEVX(1:8)
  238.                          DO 15 IU=1,ITE1
  239.                            IF (MLMOT1.MOTS(IU).EQ.NOMVXT) GOTO 16
  240.  15                      CONTINUE
  241.                          ITE1 = ITE1 + 1
  242.                          IF (ITE1.GT.JGM) THEN
  243.                             JGM = ITE1 * 2 + 10
  244.                             SEGADJ MLMOT1
  245.                          ENDIF
  246.                          MLMOT1.MOTS(ITE1) = NOMVXT
  247.  16                      CONTINUE
  248.                       ELSE IF (NOMCHT.EQ.'MOCO'.
  249.      & AND.NOMVYT(1:4).EQ.'RAID') THEN
  250. *calcul frequentiel
  251.                          DO 151 IU=1,ITE1
  252.                            IF (MLMOT1.MOTS(IU).EQ.'TEMP') GOTO 161
  253.  151                      CONTINUE
  254.                          ITE1 = ITE1 + 1
  255.                          IF (ITE1.GT.JGM) THEN
  256.                             JGM = ITE1 * 2 + 10
  257.                             SEGADJ MLMOT1
  258.                          ENDIF
  259.                          MLMOT1.MOTS(ITE1) = 'TEMP'
  260.  161                     CONTINUE
  261.  
  262.                       ELSE
  263. * Le nom de la composante ne correspond pas a l'ordonnee de l'EVOLUTION
  264.                          MOTERR(1:8)  = NOMCHT
  265.                          MOTERR(9:20) = NOMEVY
  266.                          CALL ERREUR(678)
  267. C                         SEGDES KEVOLL
  268. C                         SEGDES MELVAL
  269. C                         SEGDES MCHAML
  270.                          GOTO 9000
  271.                       END IF
  272. C                      SEGDES KEVOLL
  273.  14                 CONTINUE
  274.  13               CONTINUE
  275. C                  SEGDES MELVAL
  276.                 ELSE IF (ICAS.EQ.2) THEN
  277.                   DO 17 IU=1,ITE1
  278.                     IF( MLMOT1.MOTS(IU) . EQ.NOMCHT) GO TO 18
  279.  17               CONTINUE
  280.                   ITE1 = ITE1+1
  281.                   IF (ITE1.GT.JGM) THEN
  282.                     JGM = ITE1 * 2 + 10
  283.                     SEGADJ MLMOT1
  284.                   ENDIF
  285.                   MLMOT1.MOTS(ITE1) = NOMCHT
  286.  18               CONTINUE
  287.                 ENDIF
  288. C
  289.              ELSE IF (TYPCHE(I2).EQ.'POINTEURLISTMOTS') THEN
  290. C
  291.                 IF (ICAS.EQ.1) THEN
  292. C
  293.                    MELVAL=IELVAL(I2)
  294. C                  SEGACT,MELVAL
  295.                    N2PTEL=IELCHE(/1)
  296.                    N2EL=IELCHE(/2)
  297. C
  298. C                  Le LISTMOTS donne les noms des variables dont depend
  299. C                  la composante, dans l'optique d'une evaluation de la
  300. C                  composante par une fonction externe.
  301. C                  HYPOTHESE de CHAMP UNIFORME : la composante depend
  302. C                  des memes variables en tout point d'integration de
  303. C                  tout element de la sous-zone.
  304. C                  Cette hypothese est necessaire car la composante ne
  305. C                  peut etre associee qu'a une seule fonction externe.
  306. C                  EN CONFORMITE AVEC VARINU.eso
  307. C
  308.                    IF (N2PTEL.NE.1.AND.N2EL.NE.1) THEN
  309.                       MOTERR=NOMCHE(I2)
  310.                       CALL ERREUR(953)
  311.                       GOTO 9000
  312.                    ENDIF
  313.                    MLMOT2=IELCHE(1,1)
  314. C                  SEGACT,MLMOT2
  315.                    JESIMU=0
  316.                    IF(MLMOT2.MOTS(1)(1:4).EQ.MOTSIM) THEN
  317.                      JESIMU=1
  318.                    ENDIF
  319.                    NPARA=MLMOT2.MOTS(/2)-JESIMU
  320.                    IF (ITE1.EQ.0) THEN
  321.                       ITE1=NPARA
  322.                       IF (ITE1.GT.JGM) THEN
  323.                          JGM=NPARA
  324.                          SEGADJ,MLMOT1
  325.                       ENDIF
  326.                       DO 19 IP=1,NPARA
  327.                          JP=IP+JESIMU
  328.                          MLMOT1.MOTS(IP)=MLMOT2.MOTS(JP)
  329.   19                  CONTINUE
  330.                    ELSE
  331.                       DO 20 IP=1,NPARA
  332.                          NOMCHT = MLMOT2.MOTS(IP+JESIMU)
  333.                          DO 21 IU=1,ITE1
  334.                             IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 20
  335.   21                     CONTINUE
  336.                          ITE1=ITE1+1
  337.                          IF (ITE1.GT.JGM) THEN
  338.                             JGM=JGM+20
  339.                             SEGADJ,MLMOT1
  340.                          ENDIF
  341.                          MLMOT1.MOTS(ITE1)=NOMCHT
  342.   20                  CONTINUE
  343.                    ENDIF
  344. C                   SEGDES,MLMOT2
  345. C                   SEGDES,MELVAL
  346. C
  347.                 ELSE IF (ICAS.EQ.2) THEN
  348. C
  349.                    NOMCHT = NOMCHE(I2)(1:8)
  350.                    DO 22 IU=1,ITE1
  351.                       IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 23
  352.  22                CONTINUE
  353.                    ITE1=ITE1+1
  354.                    IF (ITE1.GT.JGM) THEN
  355.                       JGM=JGM+20
  356.                       SEGADJ,MLMOT1
  357.                    ENDIF
  358.                    MLMOT1.MOTS(ITE1)=NOMCHT
  359.  23                CONTINUE
  360. C
  361.                 ENDIF
  362. C
  363. *-------- Cas d'une table
  364.              ELSE IF (TYPCHE(I2).EQ.'POINTEURTABLE') THEN
  365. C
  366.                 IF (ICAS.EQ.1) THEN
  367. C
  368.                    MELVAL=IELVAL(I2)
  369. C                  SEGACT,MELVAL
  370.                    N2PTEL=IELCHE(/1)
  371.                    N2EL=IELCHE(/2)
  372. C
  373. C                  La Table contient un LISTMOTS qui donne les
  374. C                  noms des variables dont depend
  375. C                  la composante, dans l'optique d'une evaluation de la
  376. C                  composante par une fonction externe.
  377. C                  HYPOTHESE de CHAMP UNIFORME : la composante depend
  378. C                  des memes variables en tout point d'integration de
  379. C                  tout element de la sous-zone.
  380. C                  Cette hypothese est necessaire car la composante ne
  381. C                  peut etre associee qu'a une seule fonction externe.
  382. C                  EN CONFORMITE AVEC VARINU.eso
  383. C
  384.                    IF (N2PTEL.NE.1.AND.N2EL.NE.1) THEN
  385.                       MOTERR(1:8)=NOMCHE(I2)(1:8)
  386.                       CALL ERREUR(953)
  387.                       GOTO 9000
  388.                    ENDIF
  389.                    MTAB1=IELCHE(1,1)
  390.                    SEGACT,MTAB1
  391.                    if (NBESC.NE.0) SEGACT IPILOC
  392. C     Recherche de la liste de mots a ouvrir
  393.                    ivar = 0
  394.                    DO 630 IN=1,MTAB1.MLOTAB
  395.                       if (mtab1.mtabti(in).ne.'MOT') goto 630
  396.                       IP=MTAB1.MTABII(IN)
  397.                       IDEBCH=IPCHAR(IP)
  398.                       IFINCH=IPCHAR(IP+1)-1
  399.                       IF (ICHARA(IDEBCH:IFINCH).EQ.'VARIABLES') IVAR=IN
  400.  630               CONTINUE
  401.                    if (ivar.eq.0) GOTO 631
  402.                    MLMOT2=MTAB1.MTABIV(IVAR)
  403.                    SEGACT,MLMOT2
  404.                    JESIMU=0
  405.                    IF(MLMOT2.MOTS(1)(1:4).EQ.MOTSIM) THEN
  406.                      JESIMU=1
  407.                    ENDIF
  408.                    NPARA=MLMOT2.MOTS(/2)-JESIMU
  409.                    IF (ITE1.EQ.0) THEN
  410.                       ITE1=NPARA
  411.                       IF (NPARA.GT.JGM) THEN
  412.                          JGM=NPARA
  413.                          SEGADJ,MLMOT1
  414.                       ENDIF
  415.                       DO 29 IP=1,NPARA
  416.                          JP=IP+JESIMU
  417.                          MLMOT1.MOTS(IP)=MLMOT2.MOTS(JP)
  418.   29                  CONTINUE
  419.                    ELSE
  420.                       DO 30 IP=1,NPARA
  421.                          NOMCHT = MLMOT2.MOTS(IP+JESIMU)
  422.                          DO 31 IU=1,ITE1
  423.                             IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GOTO 30
  424.   31                     CONTINUE
  425.                          ITE1=ITE1+1
  426.                          IF (ITE1.GT.JGM) THEN
  427.                             JGM=JGM+20
  428.                             SEGADJ,MLMOT1
  429.                          ENDIF
  430.                          MLMOT1.MOTS(ITE1)=NOMCHT
  431.   30                  CONTINUE
  432.                    ENDIF
  433. C                   SEGDES,MLMOT2
  434.  631               CONTINUE
  435.                    if (NBESC.NE.0) SEGDES,IPILOC
  436.                    SEGDES,MTAB1
  437. C                   SEGDES,MELVAL
  438. C
  439.                 ELSE IF (ICAS.EQ.2) THEN
  440. C
  441.                    NOMCHT =NOMCHE(I2)(1:8)
  442.                    DO 32 IU=1,ITE1
  443.                       IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 33
  444.  32                CONTINUE
  445.                    ITE1=ITE1+1
  446.                    IF (ITE1.GT.JGM) THEN
  447.                       JGM=JGM+20
  448.                       SEGADJ,MLMOT1
  449.                    ENDIF
  450.                    MLMOT1.MOTS(ITE1)=NOMCHT
  451.  33                CONTINUE
  452. C
  453.                 ENDIF
  454. C
  455. *-------- Cas d'un CHARGEMENT (DEVA = TEMP, COVA = "nom composante")
  456.              ELSE IF (TYPCHE(I2).EQ.'POINTEURCHARGEME') THEN
  457. C
  458.                 IF (ICAS.EQ.1) THEN
  459.                   NOMCHT = 'TEMP'
  460.                 ELSE IF (ICAS.EQ.2) THEN
  461.                   NOMCHT = NOMCHE(I2)(1:8)
  462.                 ENDIF
  463. C
  464. C               On verifie si NOMCHT pas deja dans la liste :
  465.                 DO 40 IU=1,ITE1
  466.                   IF( MLMOT1.MOTS(IU).EQ.NOMCHT) GOTO 41
  467.  40             CONTINUE
  468.                 ITE1 = ITE1+1
  469.                 IF (ITE1.GT.JGM) THEN
  470.                   JGM = JGM + 20
  471.                   SEGADJ MLMOT1
  472.                 ENDIF
  473.                 MLMOT1.MOTS(ITE1) = NOMCHT
  474.  41             CONTINUE
  475. C
  476. *-------- le type de la composante du mchaml est incorrect ----------
  477.              ELSE
  478.                 MOTERR(1:8) = NOMCHE(I2)(1:8)
  479.                 CALL ERREUR(679)
  480.                 GOTO 9000
  481.              END IF
  482.  
  483.   2       CONTINUE
  484. C          SEGDES MCHAML
  485.   1    CONTINUE
  486.  
  487.        IF (ITE1.NE.JGM) THEN
  488.          JGM = ITE1
  489.          SEGADJ MLMOT1
  490.        ENDIF
  491.  
  492.  9000  CONTINUE
  493.        IF (IERR.NE.0) THEN
  494.          SEGSUP,MLMOT1
  495.          ILISR = 0
  496.        ELSE
  497.          SEGDES,MLMOT1
  498.          ILISR = MLMOT1
  499.        ENDIF
  500. C       SEGDES MCHELM
  501.  
  502.        RETURN
  503.        END
  504.  
  505.  
  506.  
  507.  

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