Sources Esope | Cast3M

tab2my
C TAB2MY    SOURCE    PV        20/03/24    21:22:26     10554          
c
      SUBROUTINE TAB2MY(iin,iityp,iicpr,iout)
*      
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
************************************************************************
*
* FONCTION : "DEBOBINAGE"" D'UNE TABLE SPECIFIQUE 
*             DANS UN SEGMENT MYTAB + PERFORMANT
*
* INPUT : iin : objet de type MTABLE
*         iityp : type de table  = | 1 : BASE_MODALE
*                                  | 2 : LIAISONS_STATIQUES
*                                  | ...
*         iicpr (si non nul) : segment ICPR a remplir
*
* OUTPUT : iicpr : segment ICPR rempli
*          iout : segment MYTAB rempli
*
* REMARQUES : les objets en entree sont deja actifs 
*             ipiloc est aussi deja actif
*             les sous-tables sont activees ici
*
* CREATION : BP, 12/12/2017
*
************************************************************************
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMTABLE
-INC CCNOYAU
-INC CCASSIS
************************************************************************
*  -INC TMYTAB
*                                                                       
*     SEGMENT POUR "DEBOBINER" UN OBJET DE TYPE 'TABLE' 
*     D'UN SOUSTYPE PARTICULIER PRECISE PAR ITYTAB                                                  
*     Le but est de faciliter la programmation esope notamment en //
*
*     ITYTAB = | BASE_MODALE
*              | LIAISONS_STATIQUES
*              | ... a completer
*
*     KPTREP(i) = POINT_REPERE du ieme mode/solution statique
*     KDEFO(i)  = DEFORMEE_MODALE / DEFORMEE
*     KICPR(#noeud POINT_REPERE) = i^eme mode
*     DDLLIA(i) = composante de la liaison statique
*     KPTLIA(i) = point en jeu dans la liaison statique
*
 
      SEGMENT MYTAB                                                           
       CHARACTER*24 ITYTAB                                                       
       INTEGER      KPTREP(NMY),KDEFO(NMY)
       INTEGER      KICPR(NMY2)
       CHARACTER*4  DDLLIA(NMY3)
       INTEGER      KPTLIA(NMY3)
      ENDSEGMENT                                                                
      POINTEUR MYTAB1.MYTAB,MYTAB2.MYTAB,MYTAB3.MYTAB                                         
 
************************************************************************
 
c     ICPR(ip)=nombre de fois ou l'on a vu le noeud POINT_LIAISON ip
      SEGMENT ICPR(nbpts)
 
      CHARACTER*24 CHARIN
      CHARACTER*4  MOTDDL
 
 
************************************************************************
*     PRELIMINAIRES
************************************************************************
 
      if(nbesc.ne.0) segact,ipiloc
 
*     RECUP DE LA TABLE EN ENTREE (ACTIVE)
      MTABLE=iin
 
*     CREATION DU MYTAB DE SORTIE
      NMY=MLOTAB
      NMY2=nbpts
      IF (iityp.EQ.1) THEN
        NMY3=0
      ELSEIF (iityp.EQ.2) THEN
        NMY3=NMY
        ICPR=iicpr
      ELSE
        CALL ERREUR(5)
        RETURN
      ENDIF      
      SEGINI,MYTAB
      iout=MYTAB
 
*     TYPE DE LA TABLE EN ENTREE ET AIGUILLAGE
      IF (iityp.EQ.1) THEN
        ITYTAB='BASE_MODALE'
        GOTO 100
      ELSEIF (iityp.EQ.2) THEN
        ITYTAB='LIAISONS_STATIQUES'      
        GOTO 200
      ENDIF
 
 
************************************************************************
*     TABLE BASE_MODALE
************************************************************************
 
 100  CONTINUE
 
      NMY=0
C     BOUCLE SUR LES MODES
      DO 101 im=1,MLOTAB
 
        IF (MTABTI(im).ne.'ENTIER  ') GOTO 101
        jm=MTABII(im)
c       MTABTV.eq.'TABLE' par construction : on ouvre la sous-table
        MTAB1=MTABIV(im)
        SEGACT,MTAB1
        NMY=NMY+1
 
c       BOUCLE SUR LES INFOS DU MODE jm CONTENUES DANS MTAB1
        IF(MTAB1.MLOTAB.gt.0) THEN
        DO 102 im1=1,MTAB1.MLOTAB
 
          IF(MTAB1.MTABTI(im1).NE.'MOT   ') GOTO 102
c         recup du MOT indice dans CHARIN
          ip=MTAB1.MTABII(im1)
          id=IPCHAR(IP)
          ifi=IPCHAR(IP+1)-1
          CHARIN=ICHARA(id:ifi)
c           print *,'mode',jm,'info #',im1,CHARIN
          IF(CHARIN.EQ.'POINT_REPERE') THEN
            iprep=MTAB1.MTABIV(im1)
            KPTREP(jm)=iprep
            KICPR(iprep)=jm
          ELSEIF(CHARIN.EQ.'DEFORMEE_MODALE') THEN
            KDEFO(jm)=MTAB1.MTABIV(im1)
          ENDIF
 
 102    CONTINUE
        ENDIF
 
 101  CONTINUE
C     FIN DE BOUCLE SUR LES MODES
 
      SEGADJ,MYTAB 
      GOTO 999
 
 
************************************************************************
*     TABLE LIAISONS_STATIQUES
************************************************************************
 
 200  CONTINUE
 
      NMY=0
C     BOUCLE SUR LES MODES
      DO 201 im=1,MLOTAB
 
        IF (MTABTI(im) .ne. 'ENTIER  ') GOTO 201
        jm=MTABII(im)
c       MTABTV.eq.'TABLE' par construction : on ouvre la sous-table
        MTAB1=MTABIV(im)
        SEGACT,MTAB1
        NMY=NMY+1
 
c       BOUCLE SUR LES INFOS DU MODE jm CONTENUES DANS MTAB1
        IF(MTAB1.MLOTAB .gt. 0) THEN
        DO 202 im1=1,MTAB1.MLOTAB
 
          IF(MTAB1.MTABTI(im1).NE.'MOT   ') GOTO 202
c         recup du MOT indice dans CHARIN (necessite ipiloc)
          ip=MTAB1.MTABII(im1)
          id=IPCHAR(IP)
          ifi=IPCHAR(IP+1)-1
          CHARIN=ICHARA(id:ifi)
          IF(CHARIN.EQ.'POINT_REPERE') THEN
            iprep=MTAB1.MTABIV(im1)
            KPTREP(jm)=iprep
            KICPR(iprep)=jm
          ELSEIF(CHARIN.EQ.'DEFORMEE') THEN
            KDEFO(jm)=MTAB1.MTABIV(im1)
          ELSEIF(CHARIN.EQ.'POINT_LIAISON') THEN
            ipl1=MTAB1.MTABIV(im1)
            KPTLIA(jm) = ipl1
            ICPR(ipl1) = ICPR(ipl1) + 1
          ELSEIF(CHARIN.EQ.'DDL_LIAISON') THEN
            ip=MTAB1.MTABIV(im1)
            id=IPCHAR(IP)
            ifi=IPCHAR(IP+1)-1
            MOTDDL=ICHARA(id:ifi)
            DDLLIA(jm) = MOTDDL
          ENDIF
 
 202    CONTINUE
        ENDIF
 
 
 201  CONTINUE
C     FIN DE BOUCLE SUR LES MODES
 
      NMY3=NMY
      SEGADJ,MYTAB
      GOTO 999
 
 
************************************************************************
*     FIN DU SOUS-PROGRAMME 
************************************************************************
 999  CONTINUE
c       SEGADJ,MYTAB
c     attention a bien desactiver ipiloc si ASSISTANT et pas sinon
      if (nbesc.ne.0) SEGDES,IPILOC
      RETURN
      END