Télécharger la plaquette Cast3M


fr en

Télécharger normod.eso

Retour à la liste

Numérotation des lignes : 

normod

  1. C NORMOD    SOURCE    CB215821  20/11/25    13:35:08     10792          
  2.       SUBROUTINE NORMOD(ITBAS,LCHAIN)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5.  
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Normalise le mode                                              *
  9. *                                                                    *
  10. *     Param}tres:                                                    *
  11. *                                                                    *
  12. * e   ITBAS   table de sous-type BASE_DE_MODES contenant les modes   *
  13. *             de la structure                                        *
  14. *                                                                    *
  15. *     Auteur, date de cr{ation:                                      *
  16. *                                                                    *
  17. *     Lionel VIVAN, le 15 juin 1990.                                 *
  18. *                                                                    *
  19. *--------------------------------------------------------------------*
  20. *                                                                    *
  21.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24. -INC SMCHPOI
  25. -INC SMCHAML
  26. -INC SMTABLE
  27. *
  28.       INTEGER LCHAIN(*)
  29.       CHARACTER*(LOCOMP) COMP
  30. *
  31.       MTABLE = ITBAS
  32.       SEGACT MTABLE
  33.       LONG = MLOTAB
  34.       IM = 1
  35.       DO 10 I = 1,LONG
  36.          IF (MTABTI(I).EQ.'ENTIER  ' .AND. MTABII(I).EQ.IM .AND.
  37.      &                   MTABTV(I).EQ.'TABLE   ') THEN
  38.             ITMOD = MTABIV(I)
  39.             IM = IM + 1
  40.             MTAB1 = ITMOD
  41.             SEGACT MTAB1
  42.             LON1 = MTAB1.MLOTAB
  43.             XGRA = 0.D0
  44.             DO 20 I1 = 1,LON1
  45.                IF (MTAB1.MTABTI(I1).EQ.'MOT     ' .AND.
  46.      &                MTAB1.MTABII(I1).EQ.LCHAIN(3) .AND.
  47.      &                MTAB1.MTABTV(I1).EQ.'CHPOINT ') THEN
  48.                   ICHDEP = MTAB1.MTABIV(I1)
  49.                   MCHPOI = ICHDEP
  50.                   SEGACT MCHPOI
  51.                   NSOU = IPCHP(/1)
  52.                   DO 22 INS = 1,NSOU
  53.                      MSOUPO = IPCHP(INS)
  54.                      SEGACT MSOUPO
  55.                      MPOVAL = IPOVAL
  56.                      SEGACT MPOVAL
  57.                      NBP = VPOCHA(/1)
  58.                      NBC = VPOCHA(/2)
  59.                      DO 24 IC = 1,NBC
  60.                        COMP = NOCOMP(IC)
  61.                        IF (COMP(1:1).EQ.'U' .OR. COMP(1:1).EQ.'R') THEN
  62.                           DO 26 IP = 1,NBP
  63.                              XVAL = VPOCHA(IP,IC)
  64.                              XAVA = ABS(XVAL)
  65.                              IF (XAVA.GT.XGRA) XGRA = XAVA
  66.  26                          CONTINUE
  67. *                         end do
  68.                        ENDIF
  69.  24                    CONTINUE
  70. *                    end do
  71.                      SEGDES MPOVAL
  72.                      SEGDES MSOUPO
  73.  22                  CONTINUE
  74. *                 end do
  75.                   DO 32 INS = 1,NSOU
  76.                      MSOUPO = IPCHP(INS)
  77.                      SEGACT MSOUPO
  78.                      MPOVAL = IPOVAL
  79.                      SEGACT MPOVAL
  80.                      NBP = VPOCHA(/1)
  81.                      NBC = VPOCHA(/2)
  82.                      DO 34 IC = 1,NBC
  83.                        COMP = NOCOMP(IC)
  84.                        IF (COMP(1:1).EQ.'U' .OR. COMP(1:1).EQ.'R') THEN
  85.                           DO 36 IP = 1,NBP
  86.                              XDEP = VPOCHA(IP,IC)
  87.                              VPOCHA(IP,IC) = XDEP / XGRA
  88.  36                          CONTINUE
  89. *                         end do
  90.                        ENDIF
  91.  34                    CONTINUE
  92. *                    end do
  93.                      SEGDES MPOVAL
  94.                      SEGDES MSOUPO
  95.  32                  CONTINUE
  96. *                 end do
  97.                   SEGDES MCHPOI
  98.                   MTAB1.MTABIV(I1) = ICHDEP
  99.                ENDIF
  100.  20            CONTINUE
  101. *           end do
  102.             DO 40 I1 = 1,LON1
  103.                IF (MTAB1.MTABTI(I1).EQ.'MOT     ') THEN
  104.                   IF (MTAB1.MTABII(I1).EQ.LCHAIN(2) .AND.
  105.      &                MTAB1.MTABTV(I1).EQ.'TABLE   ') THEN
  106.                      ITDEP = MTAB1.MTABIV(I1)
  107.                      MTAB2 = ITDEP
  108.                      SEGACT MTAB2
  109.                      LON2 = MTAB2.MLOTAB
  110.                      IDP = 1
  111.                      DO 42 I2 = 1,LON2
  112.                         IF (MTAB2.MTABTI(I2).EQ.'ENTIER  ' .AND.
  113.      &                      MTAB2.MTABII(I2).EQ.IDP        .AND.
  114.      &                      MTAB2.MTABTV(I2).EQ.'FLOTTANT') THEN
  115.                            IDP = IDP + 1
  116.                            XDEPG = MTAB2.RMTABV(I2)
  117.                            MTAB2.RMTABV(I2) = XDEPG / XGRA
  118.                         ENDIF
  119.  42                     CONTINUE
  120. *                    end do
  121.                      SEGDES MTAB2
  122.                      MTAB1.MTABIV(I1) = ITDEP
  123.                   ELSE IF (MTAB1.MTABII(I1).EQ.LCHAIN(19) .AND.
  124.      &                     MTAB1.MTABTV(I1).EQ.'FLOTTANT') THEN
  125.                      XMGEN = MTAB1.RMTABV(I1)
  126.                      MTAB1.RMTABV(I1) = XMGEN / (XGRA * XGRA)
  127.                   ELSE IF (MTAB1.MTABII(I1).EQ.LCHAIN(5) .AND.
  128.      &                MTAB1.MTABTV(I1).EQ.'CHPOINT ') THEN
  129.                      ICHREA = MTAB1.MTABIV(I1)
  130.                      MCHPOI = ICHREA
  131.                      SEGACT MCHPOI
  132.                      NSOU = IPCHP(/1)
  133.                      DO 50 INS = 1,NSOU
  134.                         MSOUPO = IPCHP(INS)
  135.                         SEGACT MSOUPO
  136.                         MPOVAL = IPOVAL
  137.                         SEGACT MPOVAL
  138.                         NBP = VPOCHA(/1)
  139.                         NBC = VPOCHA(/2)
  140.                         DO 52 IC = 1,NBC
  141.                            DO 54 IP = 1,NBP
  142.                               XREA = VPOCHA(IP,IC)
  143.                               VPOCHA(IP,IC) = XREA / XGRA
  144.  54                           CONTINUE
  145. *                          end do
  146.  52                       CONTINUE
  147. *                       end do
  148.                         SEGDES MPOVAL
  149.                         SEGDES MSOUPO
  150.  50                     CONTINUE
  151. *                    end do
  152.                      SEGDES MCHPOI
  153.                      MTAB1.MTABIV(I1) = ICHREA
  154.                   ELSE IF (MTAB1.MTABII(I1).EQ.LCHAIN(4) .AND.
  155.      &                MTAB1.MTABTV(I1).EQ.'MCHAML  ') THEN
  156.                      ICHCON = MTAB1.MTABIV(I1)
  157.                      MCHELM = ICHCON
  158.                      SEGACT MCHELM
  159.                       N1 = IMACHE(/1)
  160.                       DO 60 IN = 1,N1
  161.                        MCHAML = ICHAML(IN)
  162.                        SEGACT MCHAML
  163.                        NCO = IELVAL(/1)
  164.                        DO 62 ICO = 1,NCO
  165.                          MELVAL = IELVAL(ICO)
  166.                          SEGACT MELVAL
  167.                          N1P = VELCHE(/1)
  168.                          N1E = VELCHE(/2)
  169.                          DO 64 IP = 1,N1P
  170.                           DO 66 IE = 1,N1E
  171.                            XCON = VELCHE(IP,IE)
  172.                            VELCHE(IP,IE) = XCON/XGRA
  173.   66                      CONTINUE
  174.   64                     CONTINUE
  175.                          SEGDES MELVAL
  176.   62                   CONTINUE
  177.                        SEGDES MCHAML
  178.   60                  CONTINUE
  179.                      SEGDES MCHELM
  180.                      MTAB1.MTABIV(I1) = ICHCON
  181.                   ENDIF
  182.                ENDIF
  183.  40            CONTINUE
  184. *           end do
  185.             SEGDES MTAB1
  186.          ENDIF
  187.  10      CONTINUE
  188. *     end do
  189.       SEGDES MTABLE
  190. *
  191.       END
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  

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