Sources Esope | Cast3M

charge
C CHARGE    SOURCE    SP204843  26/02/03    21:15:06     12461          
      SUBROUTINE CHARGE
C
C---------------------------------------------------------------------
C
C   CREATION DE L'OBJET CHARGEMENT
C
C   SYNTAXE : CHARGE = CHAR  (MOT) | MCHAML  |  (EVOL)  |  (|'LIE '|) ...
C                                  | CHPOINT |          |   |'LIBR'|
C                                  | TABLE1     TABLE2  |
C
C       ... ( | 'TRAN' VEC1 EVOL2                |  ) ;
C             | 'ROTA' POIN1 (POIN2 si 3D) EVOL2 |
C             | 'TRAJ' TABLE3 TABLE4             |
C
C         MOT     : Nom du chargement
C         MCHAML  : Champ par element (description spatiale) du chargement
C         CHPOINT : Champ par point   (description spatiale) du chargement
C         EVOL    : Evolution de ponderation (description temporelle) du chargement
C                   facultative, le chargement est constant si absente
C         TABLE1  : Table des temps indicee par des entiers
C         TABLE2  : Table des champs (CHPOINT ou MCHAML) indicee par des
C                    entiers commancant par 0 puis 1, 2, ...
C
C   Par defaut le chargement est fixe. 3 options permettent de preciser
C   un mouvement relatif du chargement par rapport au corps etudie
C         TABLE3 : Table des temps indicee par des entiers
C         TABLE4 : Table des points de la trajectoire indicee par
C                    des entiers
C
C   CREATION : 22/02/85
C   PROGRAMMEUR : GUILBAUD
C   MODIFICATION : 02/09/94
C   PROGRAMMEUR : JEANVOINE
C   EXTENSION : /02/98 KICH
C-----------------------------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMCHARG
-INC SMCHPOI
-INC SMCHAML
-INC SMTABLE
-INC SMLREEL
-INC SMEVOLL
-INC SMELEME
-INC SMLOBJE
 
      CHARACTER*4 MOT1,MOT2,MOCLE(6)
      CHARACTER*8 MOT3,MOT4
 
      DATA MOCLE /'LIBR','LIE ','STAT','TRAN','ROTA','TRAJ'/
 
      IRETO1=0
      IRETO2=0
      IRETO3=0
      IRETO4=0
      IRETO5=0
C----------------------- Lecture obligatoire du nom --------------------
 
      CALL LIRCHA(MOT2,0,LCHA)
      IF (LCHA.NE.0) THEN
        CALL PLACE(MOCLE,6,IPLAC,MOT2)
C       Si MOT2 pas dans MOCLE, c'est le nom du chargement > MOT1
        IF (IPLAC.EQ.0) THEN 
          MOT1 = MOT2
          MOT2 = '    '
C       Si MOT2 dans MOCLE et vaut TRAJ, on ne veut pas un 2e mot TRAJ (exclu)
        ELSEIF (IPLAC.EQ.6) THEN
          CALL LIRCHA(MOT1,0,LCHA1)
          IF (LCHA1.NE.0) THEN
            IF (MOT1.EQ.'TRAJ') THEN
              CALL ERREUR(696)
              RETURN
            ENDIF
          ELSE
C           Si on ne lit que le mot TRAJ, c'est un chargement de nom TRAJ :
            MOT1 = MOT2
            MOT2 = '    '
          ENDIF
        ELSE
C       Si MOT2 dans MOCLE, nom du chargement inconnu (='    ')
          MOT1 = '    '
        ENDIF
      ENDIF
      IF (IERR.NE.0) RETURN
C
C---------------- Lecture du MCHAML,CHPOINT ou  TABLE ------------------
C     Syntaxe avec 2 TABLEs :
      CALL LIROBJ('TABLE   ',ITA1,0,IRETO1)
C     -- si presence d'une TABLE, on va chercher la seconde TABLE
      IF (IRETO1.EQ.1) THEN
         CALL LIROBJ('TABLE   ',ITA2,1,IRETOU)
          IF (IERR.NE.0) RETURN
      ELSE
C       Syntaxe avec LISTOBJE :
        CALL LIROBJ('LISTOBJE',ILOB1,0,IRETO5)
        IF (IRETO5.EQ.1) THEN
          CALL LIROBJ('LISTREEL',ILRE1,1,IRETOU)
          IF (IERR.NE.0) RETURN
        ELSE
C       Syntaxe avec 1 champ et 1 EVOLUTIOn :
C         -- y a t'il un CHPOINT ?
          CALL LIROBJ('CHPOINT ',ICH1,0,IRETO2)
          IF (IRETO2.EQ.1) THEN
            CALL ACTOBJ('CHPOINT ',ICH1,1)
            IF (IERR.NE.0) RETURN
C         -- si pas de CHPOINT, on exige la lecture d'un MCHAML
          ELSE
            CALL LIROBJ('MCHAML ',ICH2,1,IRETO3)
            CALL ACTOBJ('MCHAML ',ICH2,1)
            IF (IERR.NE.0) RETURN
          ENDIF
C         -- y a t'il une EVOLUTIOn ?
          CALL LIROBJ('EVOLUTIO',MEVOLL,0,IRETO4)
C         -- si pas d'EVOLUTIOn, le chargement sera constant
          IF (IRETO4.EQ.0) THEN
            MEVOLL=0
          ENDIF
        ENDIF
      ENDIF
 
      N=1
      SEGINI MCHARG
      SEGINI ICHARG
      KCHARG(1)=ICHARG
      CHANAT='FORCE'
      IF (LCHA.NE.0) THEN
         if(mot1.eq.'PSUI') then
          call erreur(994)
          return
         endif
         CHANOM = MOT1
      ELSE
         CHANOM = '    '
      ENDIF
 
C------------------ cas du CHPOINT ou du MCHAML --------------------
 
      IF((IRETO2.EQ.1).OR.(IRETO3.EQ.1)) THEN
C        Cas general, on recupere les LISTREELs de l'evolution
         IF (IRETO4.EQ.1) THEN
           SEGACT MEVOLL
           IEV1 = IEVOLL(/1)
           IF (IEV1.NE.1) THEN
              CALL ERREUR(687)
              RETURN
           ENDIF
           KEVOLL=IEVOLL(1)
           SEGACT KEVOLL
           MLREE1 = IPROGX
           MLREE2 = IPROGY
           SEGACT MLREE1,MLREE2
           IF (MLREE1.PROG(/1) .LT. 2 .OR. MLREE2.PROG(/1) .LT. 2) THEN
* la dimension des LISTREEL doit etre plus grande que 1
              SEGSUP MCHARG,ICHARG
              CALL ERREUR(897)
              RETURN
           ENDIF
           ICHPO2=IPROGX
           ICHPO3=IPROGY
C        Cas du chargement constant
         ELSE
           ICHPO2=0
           ICHPO3=0
         ENDIF
         IF(IRETO2.EQ.1) THEN
            CHATYP = 'CHPOINT '
            ICHPO1 = ICH1
         ELSE
            CHATYP = 'MCHAML  '
            ICHPO1 = ICH2
         ENDIF
         IF (CHATYP.EQ.'CHPOINT ') THEN
           MCHPOI = ICH1
           CALL ACTOBJ('CHPOINT ',MCHPOI,1)
C           SEGACT,MCHPOI
           IF (IPCHP(/1) .GE. 1) THEN
             MSOUPO = IPCHP(1)
C            SEGACT,MSOUPO
             IF ((NOCOMP(1).EQ.'FX  '.OR.NOCOMP(1).EQ.'FY  '.OR.
     $            NOCOMP(1).EQ.'FZ  '.OR.NOCOMP(1).EQ.'FR  '.OR.
     $            NOCOMP(1).EQ.'FT  '.OR.NOCOMP(1).EQ.'MR  '.OR.
     $            NOCOMP(1).EQ.'MT  '.OR.NOCOMP(1).EQ.'MX  '.OR.
     $            NOCOMP(1).EQ.'MY  '.OR.NOCOMP(1).EQ.'MZ  ')
     $            .AND.(CHANOM.EQ.'    '))   CHANOM = 'MECA'
           ENDIF
         ENDIF
 
*----------------------- cas avec LISTOBJE ----------------------
 
      ELSEIF (IRETO5.EQ.1) THEN
         CHATYP = 'LISTOBJE'
         ICHPO1 = ILOB1
         ICHPO2 = ILRE1
 
C        Verification de la dimension des deux listes :
         MLOBJE = ILOB1
         SEGACT, MLOBJE
         IF (TYPOBJ.EQ.'FLOTTANT') THEN
           CALL ERREUR(21)
           RETURN
         ENDIF
         MLREEL = ILRE1
         SEGACT, MLREEL
         IF (LISOBJ(/1).NE.PROG(/1)) THEN
           CALL ERREUR(217)
           RETURN
         ENDIF
 
*------------------------- cas des TABLES -----------------------
 
      ELSE
C        Forcement syntaxe avec TABLES
C        Si pas IRETO1, ERREUR(5) (cas impossible a priori)
         IF (IRETO1.NE.1) THEN
           CALL ERREUR(5)
           RETURN
         ENDIF
         CHATYP = 'TABLE   '
         ICHPO1 = ITA1
         ICHPO2 = ITA2
C        dip : ajout de quelques tests sur les tables de chargement
         MTAB1 = ITA1
         MTAB2 = ITA2
         SEGACT,MTAB1,MTAB2
C        - les 2 tables doivent avoir la meme dimension
         I1 = MTAB1.MLOTAB
         I2 = MTAB2.MLOTAB
         IF (I1.NE.I2) THEN
           MOTERR(1:4)='CHAR'
           MOTERR(5:12)='TABLE   '
           CALL ERREUR(125)
           RETURN
         ENDIF
         DO N=1,I1
C          - les indices des 2 tables doivent etre ENTIERs
           MOT3=MTAB1.MTABTI(N)
           MOT4=MTAB2.MTABTI(N)
           IF ((MOT3.NE.'ENTIER  ').OR.(MOT4.NE.'ENTIER  ')) THEN
             CALL ERREUR(647)
             RETURN
           ENDIF
C          - la table 1 doit contenir des FLOTTANTs
           MOT3=MTAB1.MTABTV(N)
           MOT4=MTAB2.MTABTV(N)
           IF (MOT3.NE.'FLOTTANT') THEN
             CALL ERREUR(692)
             RETURN
           ENDIF
C SP : je retire ce test
*   => on peut mettre ce qu'on veut en indice de la 2e table
C          - la table 2 doit contenir des CHPOINTs ou des MCHAMLs
C          IF ((MOT4.NE.'CHPOINT ').AND.(MOT4.NE.'MCHAML  ')) THEN
C            CALL ERREUR(694)
C            RETURN
C          ENDIF
C          - les indices doivent etre croissants de 0 a (N-1)
           IND1=MTAB1.MTABII(N)
           IND2=MTAB2.MTABII(N)
           IF ((IND1.NE.(N-1)).OR.(IND2.NE.(N-1))) THEN
             CALL ERREUR(647)
             RETURN
           ENDIF
C          - les instants de la table 1 doivent etre croissants
           IF (N.EQ.1) THEN
             XTPP=MTAB1.RMTABV(N)
           ELSE
             XTP1=MTAB1.RMTABV(N)
             IF (XTP1.LT.XTPP) THEN
               CALL ERREUR(285)
               RETURN
             ENDIF
             XTPP=XTP1
           ENDIF
         ENDDO
      ENDIF
C----------------------- Lecture des mots-cle optionnels ------------------
       IRETOU = 0
       IRETO1 = 0
       IRETO2 = 0
      IF (MOT2.EQ.'    ') CALL LIRCHA(MOT2,0,LCHA)
      IF (LCHA.NE.0) THEN
        IF (MOT2.EQ.'LIBR') THEN
          CHALIE = 'LIBR'
          CALL LIRCHA(MOT2,0,LCHA)
        ELSEIF(MOT2.EQ.'LIE ') THEN
          CHALIE='LIE '
          CALL LIRCHA(MOT2,0,LCHA)
        ELSE
          CHALIE='LIE '
        ENDIF
      ELSE
        CHALIE='LIE '
      ENDIF
 
      IF (LCHA.NE.0) THEN
 
         IF (MOT2.EQ.'TRAN') THEN
           CHAMOB = MOT2
           CALL LIROBJ('POINT   ',IPT1,1,IRETO1)
           IF(IERR.NE.0) RETURN
           CALL CRELEM(IPT1)
           CALL CRECH1(IPT1,1)
           ICHPO4 = IPT1
           CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
           IF(IERR.NE.0) RETURN
 
         ELSE IF (MOT2.EQ.'ROTA') THEN
           CHAMOB = MOT2
           CALL LIROBJ('POINT   ',IPT1,1,IRETO1)
           IF(IERR.NE.0) RETURN
           CALL CRELEM(IPT1)
           CALL CRECH1(IPT1,1)
           ICHPO4 = IPT1
           IF (IDIM.GE.3) THEN
            CALL LIROBJ('POINT   ',IPT2,1,IRETO2)
            IF(IERR.NE.0) RETURN
            CALL CRELEM(IPT2)
            CALL CRECH1(IPT2,1)
            ICHPO5 = IPT2
           ENDIF
           CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
           CALL ACTOBJ('EVOLUTIO',MEVOLL,1)
           IF(IERR.NE.0) RETURN
 
         ELSE IF (MOT2.EQ.'TRAJ') THEN
           CHAMOB = MOT2
           CALL LIROBJ('CHPOINT ',ITA1,1,IRETO1)
           CALL ACTOBJ('CHPOINT ',ITA1,1)
           IF(IERR.NE.0) RETURN
 
         ELSE
*
           GOTO 900
         ENDIF
 
      ELSE
         CHAMOB = 'STAT'
      ENDIF
*
      IF ((MOT2.EQ.'TRAN').OR.(MOT2.EQ.'ROTA')) THEN
         SEGACT MEVOLL
         IEV1 = IEVOLL(/1)
         IF (IEV1.NE.1) THEN
            CALL ERREUR(687)
            RETURN
         ENDIF
         KEVOLL=IEVOLL(1)
         SEGACT KEVOLL
         MLREE1 = IPROGX
         MLREE2 = IPROGY
         SEGACT MLREE1,MLREE2
         IF (MLREE1.PROG(/1).LT.2.OR.MLREE2.PROG(/1).LT.2) THEN
* la dimension des LISTREEL doit etre plus grande que 1
            SEGSUP ICHARG,MCHARG
            CALL ERREUR(897)
            RETURN
         ENDIF
         ICHPO6=IPROGX
         ICHPO7=IPROGY
      ELSE IF (MOT2.EQ.'TRAJ') THEN
         MCHPO2 = ITA1
         CALL ACTOBJ('CHPOINT ',MCHPO2,1)
         NSOUPO = MCHPO2.IPCHP(/1)
         IF (NSOUPO.GT.1) THEN
            SEGSUP ICHARG,MCHARG
* le champ doit posseder une seule composante
            CALL ERREUR(898)
            RETURN
         ENDIF
         MSOUP2 = MCHPO2.IPCHP(1)
C        SEGACT MSOUP2
         NC = MSOUP2.NOCOMP(/2)
         IF (NC.GT.1) THEN
            SEGSUP ICHARG,MCHARG
* le champ doit posseder une seule composante
            CALL ERREUR(898)
            RETURN
         ENDIF
         IF (MSOUP2.NOCOMP(1).NE.'TEMP') THEN
            SEGSUP ICHARG,MCHARG
* le nom de la composante doit etre TEMP
            CALL ERREUR(898)
            RETURN
         ENDIF
 
         ICHPO4 = MCHPO2
         ICHPO5 = MSOUP2.IGEOC
         MPOVA2 = MSOUP2.IPOVAL
C        SEGACT MPOVA2
         JG = MPOVA2.VPOCHA(/1)
         SEGINI MLREE2
         ICHPO6 = MLREE2
         DO IVO = 1,JG
           MLREE2.PROG(IVO) = MPOVA2.VPOCHA(IVO,1)
         ENDDO
      ENDIF
*
 900  CONTINUE
      CALL ACTOBJ('CHARGEME',MCHARG,1)
      CALL ECROBJ('CHARGEME',MCHARG)
      END