Download elfcha.eso

Back to the list

   1 : C ELFCHA    SOURCE    AM        08/02/14    21:21:17     6050           
   2 :       SUBROUTINE ELFCHA(MCHARG,KOMALI,KNREFE,KACHAR)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : C
   6 : C =====================================================================
   7 : C
   8 : C    CREATION DU SEGMENT MACHAR A PARTIR DE L'OBJET CHARGEMENT MCHARG
   9 : C
  10 : C    SOUS PROGRAMME APPELE PAR ELFE
  11 : C
  12 : C    KNREFE : SEGMENT QUI DECRIT LES ELEMENTS
  13 : C    KOMALI : SEGMENT DE POINTEURS SUR LES SEGMENTS MALIAI DEFINISSANT
  14 : C                  LES LIAISONS
  15 : C
  16 : C    GUILBAUD MAI 86
  17 : C
  18 : C =====================================================================
  19 : C
  20 : -INC CCOPTIO
  21 : -INC CCHAMP
  22 : -INC SMCHARG
  23 : -INC SMCHPOI
  24 : -INC SMELEME
  25 : -INC SMLREEL
  26 : C
  27 :       SEGMENT MALIAI
  28 :         REAL*8  ALIA1(NALI)
  29 :         REAL*8  ALIA2(NBLI)
  30 :         REAL*8  ALIA3(NL/2,NL/2)
  31 :         REAL*8  ALIA4(NL/2,NL/2)
  32 :         REAL*8  BLIAI(NL)
  33 :         REAL*8  XLIAI(NL)
  34 :         INTEGER NLBLI(2,NBSTLI)
  35 :         INTEGER NDCLIA(NL)
  36 :         INTEGER NVNLIA(NL/2)
  37 :         INTEGER IBCHA(NCHAL)
  38 :         POINTEUR KWLIAI.MWLIAI
  39 :         POINTEUR KLIMAS.MLIMAS
  40 :       ENDSEGMENT
  41 : C
  42 : C     MATRICE DE LIAISON PUIS SON INVERSE EN 4 BLOCS:
  43 : C     ALIA1 : MATRICE BANDE  I-A0
  44 : C                               -1
  45 : C     ALIA2 : MATRICE BANDE  -B0
  46 : C     ALIA3 : MATRICE DE LIAISON  TERMES EN DEPLACEMENT
  47 : C     ALIA4 : MATRICE DE LIAISON  TERMES EN CONTRAINTE
  48 : C     NLBLI : TABLEAU DE CORRESPONDANCE ENTRE LES BLOCS
  49 : C     BLIAI : VECTEUR SECOND MEMBRE -> VN ET CHARGEMENT EVENTUEL
  50 : C     XLIAI : VECTEUR PREMIER MEMBRE -> DNCN
  51 : C     NDCLIA(NJC)=IKID : LA NJC-IEME INCONNUE DE XLIAI EST LE IKID-IEME
  52 : C     DDL DE DNCN
  53 : C               DNCN(IKID)      <-  XLIAI(NJC)
  54 : C     NVNLIA(NJL)=IKIV : LA NJL-IEME INCONNUE DE BLIAI EST LE IKIV-IEME
  55 : C     DDL DE VN
  56 : C               BLIAI(NJL)      <-  VN(IKIV)
  57 : C     NCHAL : NOMBRE DE SOUS-CHARGEMENTS AGISSANT SUR LA LIAISON
  58 : C     IBCHA(I)=K : LA PARTIE CHARGEMENT DE BLIAI POUR LE I-IEME SOUS-
  59 : C     CHARGEMENT SE TROUVE A PARTIR DE LA K+1-IEME PLACE DANS BCHAR2
  60 : C               BLIAI(NL/2+NJL) <-  BCHAR2(K+NJL)
  61 : C
  62 :       SEGMENT MWLIAI
  63 :         REAL*8  ALIAI(NL/2,NL)
  64 :       ENDSEGMENT
  65 : C
  66 :       SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  67 : C
  68 : C                 IKID=ICPR(NUM(I,J))+K
  69 : C     LA COMPOSANTE NOMD(K) DU POINT NUM EST LE IKID-IEME DDL DE DNCN
  70 : C
  71 :       SEGMENT MACHAR
  72 :         INTEGER  LACHAL(NCHAR)
  73 :         POINTEUR LACHAT(NCHAR).ICHPO2
  74 :         POINTEUR LACHAF(NCHAR).ICHPO3
  75 :         REAL*8   BCHAR1(NV1)
  76 :         REAL*8   BCHAR2(NV1)
  77 :       ENDSEGMENT
  78 : C
  79 : C     LACHAL(I) : NOMBRE DE TERMES RELATIFS AU CHARGEMENT I DANS BCHAR1
  80 : C     LACHAT(I) : POINTEUR SUR LA LISTE DES TEMPS DU CHARGEMENT I
  81 : C     LACHAF(I) : POINTEUR SUR LA LISTE DES F(T)  DU CHARGEMENT I
  82 : C     BCHAR1 : VECTEUR FORME PAR L'EMPILEMENT DE LA PARTIE CHARGEMENT
  83 : C          DES SECOND-MEMBRES BLIAI, POUR TOUTES LES LIAISONS CONCERNEES
  84 : C          PAR UN SOUS-CHARGEMENT ET POUR TOUS LES SOUS-CHARGEMENTS
  85 : C     BCHAR2 : IDEM MODULE PAR LES FONCTIONS TEMPORELLES
  86 : C
  87 :       SEGMENT MOMALI
  88 :         POINTEUR NOMALI(NBLIPE).MALIAI
  89 :         POINTEUR KCPR2.ICPR2
  90 :       ENDSEGMENT
  91 : C
  92 :       SEGMENT MNREFE
  93 :         INTEGER NREFE(8,NSTR)
  94 :         INTEGER NTANBN
  95 :         INTEGER NIDNCN
  96 :         INTEGER NTVN
  97 :         POINTEUR NREPA.MPASS
  98 :         POINTEUR NRECA.MCARA
  99 :         POINTEUR NRENO.MNORM
 100 :         POINTEUR NRECPR.ICPR
 101 :         POINTEUR NREMEL.MELEME
 102 :         POINTEUR NREDEN.MDEN
 103 :       ENDSEGMENT
 104 : C
 105 : C   NSTR       : NOMBRE D'ELEMENTS
 106 : C   NREFE(1,I) : MELEME
 107 : C   NREFE(2,I) : MSOSTU
 108 : C   NREFE(3,I) : TYPE DE L'ELEMENT
 109 : C   NREFE(4,I) : NOMBRE DE POINTS DU MELEME
 110 : C   NREFE(5,I) : NOMBRE DE DDL PAR POINT
 111 : C   NREFE(6,I)=IVN :LE 1ER DDL DE L'ELEMENT EST LE IVN+1 IEME DE VN
 112 : C   NREFE(7,I)=IAN :LE 1ER TERME DE LA MATRICE A EST LE IAN IEME DE ANBN
 113 : C   NREFE(8,I)= 1 :LE IEME ELEMENT EST RIGIDE (OU PARTIELLEMENT) SINON 0
 114 : C   NTANBN : NOMBRE DE TERMES DES MATRICES A ET B POUR TOUS LES ELEMENTS
 115 : C   NIDNCN : NOMBRE TOTAL D'INCONNUES DE DNCN
 116 : C   NTVN   : LONGUEUR DU TABLEAU VN
 117 : C
 118 :       SEGMENT ICPR2(NIDNCN)
 119 : C
 120 : C     NJ=ICPR2(IKID) : LE IKID-IEME DDL DE DNCN EST LE NJ-IEME DANS
 121 : C     L'ENSEMBLE DES XLIAI MIS BOUT-A-BOUT
 122 : C
 123 :       SEGMENT V0(2*NTVN)*D
 124 : C
 125 :       SEGMENT ITCOM(NC)
 126 : C
 127 :       SEGMENT IT(NBLIPE)
 128 : C
 129 :       SEGMENT/ITLI/(ITLIA(NCHAR,NBLIPE))
 130 : C
 131 :       CHARACTER*4 NOC
 132 :       WRITE(IOIMP,*) 'DEBUT DE ELFCHA'
 133 :       KACHAR=0
 134 :       MNREFE=KNREFE
 135 :       ICPR=NRECPR
 136 :       SEGINI V0
 137 : C
 138 :       MOMALI=KOMALI
 139 :       ICPR2=KCPR2
 140 :       NBLIPE=NOMALI(/1)
 141 :       SEGINI IT
 142 : C
 143 :       SEGACT MCHARG
 144 :       NCHAR=KCHARG(/1)
 145 :       SEGINI ITLI
 146 :       DO 1 I=1,NBLIPE
 147 :       IT(I)=0
 148 :       DO 1 J=1,NCHAR
 149 :       ITLIA(J,I)=0
 150 :     1 CONTINUE
 151 : C
 152 :       NV1=NTVN
 153 :       SEGINI MACHAR
 154 : C
 155 : C       BOUCLE SUR LES SOUS-CHARGEMENTS DE L'OBJET CHARGEMENT
 156 : C
 157 :       NV1=0
 158 :       DO 140 I=1,NCHAR
 159 :         DO 10 II=1,NIDNCN
 160 :         V0(II)=0.D0
 161 :   10    CONTINUE
 162 : C
 163 : C   1 - RECHERCHE DE LA POSITION DU DDL CHARGE DANS L'ENSEMBLE DES XLIAI
 164 : C       ET REMPLISSAGE DE V0
 165 : C
 166 :       ICHARG=KCHARG(I)
 167 :       SEGACT ICHARG
 168 :       IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(I).NE.'STAT'
 169 :      & .OR.CHALIE(I).NE.'LIE ') THEN
 170 :          SEGDES ICHARG
 171 :          SEGDES MCHARG
 171 :          CALL ERREUR(696)
 172 :          RETURN
 173 :       ENDIF
 174 :       MCHPOI=ICHPO1
 175 :       SEGACT MCHPOI
 176 :       NSOUPO=IPCHP(/1)
 177 :          DO 70 ISOUPO=1,NSOUPO
 178 :          MSOUPO=IPCHP(ISOUPO)
 179 :          SEGACT MSOUPO
 180 :          MPOVAL=IPOVAL
 181 :          SEGACT MPOVAL
 182 :          NC=VPOCHA(/2)
 183 :          SEGINI ITCOM
 184 :            DO 40 INC=1,NC
 185 :            NOC=NOCOMP(INC)
 186 :            ITCOM(INC)=0
 187 :            DO 20 IDD=1,6
 188 :            IF(NOC.EQ.NOMDD(IDD)) THEN
 189 :              ITCOM(INC)=IDD
 190 :              GO TO 40
 191 :            ENDIF
 192 :    20      CONTINUE
 193 :            DO 30 IDU=1,6
 194 :            IF(NOC.EQ.NOMDU(IDU)) THEN
 195 :              ITCOM(INC)=IDU+6
 196 :              GO TO 40
 197 :            ENDIF
 198 :    30      CONTINUE
 199 :    40    CONTINUE
 200 : C
 201 :          MELEME=IGEOC
 202 :          SEGACT MELEME
 203 :          NBPO=NUM(/2)
 204 :          DO 60 IBPO=1,NBPO
 205 :          IKI=ICPR(NUM(1,IBPO))
 206 :          IF(IKI.EQ.-1) THEN
 207 : C  ***  LE POINT NE FAIT PAS PARTIE DE LA STRUCTURE
 208 :            INTERR(1)=IKI
 208 :            CALL ERREUR(384)
 209 :            RETURN
 210 :          ENDIF
 211 :          DO 50 INC=1,NC
 212 :          IKC=ITCOM(INC)
 213 :          IF(IKC.EQ.0) THEN
 214 : C  ***  LA COMPOSANTE N'EST PAS DEFINIE POUR LA STRUCTURE
 215 :            MOTERR(1:4)=NOCOMP(INC)
 215 :            CALL ERREUR(385)
 216 :            RETURN
 217 :          ENDIF
 218 :          VP=VPOCHA(IBPO,INC)
 219 :          IV=ICPR2(IKI+IKC)
 220 : C        WRITE(IOIMP,*) IV
 221 :          IF(VP.NE.0.D0) V0(IV)=VP
 222 :    50    CONTINUE
 223 :    60    CONTINUE
 224 :          SEGDES MELEME,MPOVAL,MSOUPO
 225 :          SEGSUP ITCOM
 226 :    70    CONTINUE
 227 :       SEGDES MCHPOI
 228 : C     WRITE(IOIMP,*)(V0(J),J=1,NIDNCN)
 229 : C
 230 : C   2 - CREATION DU TABLEAU V1 A PARTIR DE V0
 231 : C
 232 :       NDEPLA=0
 233 :       NV2=0
 234 :          DO 130 INLIAI=1,NBLIPE
 235 :          MALIAI=NOMALI(INLIAI)
 236 :          MWLIAI=KWLIAI
 237 :          NL=NDCLIA(/1)
 238 : C
 239 : C       Y A-T-IL UN CHARGEMENT SUR LA LIAISON ?
 240 : C
 241 :          DO 80 NJCC=1,NL
 242 :            IF(V0(NDEPLA+NJCC).NE.0.D0) THEN
 243 : C
 244 : C       CREATION DE LA PARTIE CHARGEMENT DU SECOND MEMBRE BLIAI
 245 : C       ET EMPILEMENT DANS BCHAR1
 246 : C
 247 :            ITT=IT(INLIAI)+1
 248 :            IT(INLIAI)=ITT
 249 :            NLS2=NL/2
 250 :            ITLIA(ITT,INLIAI)=NV1
 251 :            NVA=NV1
 252 :            NV1=NV1+NLS2
 253 :            NV2=NV2+NLS2
 254 : C          WRITE(IOIMP,*)ITT,NV1,NV2,INLIAI,NDEPLA
 255 :            DO 110 NJC=1,NL
 256 :             VV=V0(NDEPLA+NJC)
 257 :             IF(VV.NE.0.D0) THEN
 258 :               DO 100 NJ=1,NLS2
 259 : C               WRITE(IOIMP,*) ALIAI(NJL,NJC)
 260 :                 IF(ALIAI(NJ,NJC).NE.0.D0) THEN
 261 :                   NJA=NVA+NJ
 262 :                   BCHAR1(NJA)=BCHAR1(NJA)+VV
 263 : C                 WRITE(IOIMP,*) BCHAR1(NJA)
 264 :                 ENDIF
 265 :   100         CONTINUE
 266 :             ENDIF
 267 :   110      CONTINUE
 268 :            GOTO 120
 269 :           ENDIF
 270 :    80    CONTINUE
 271 :   120    NDEPLA=NDEPLA+NL
 272 :   130  CONTINUE
 273 : C
 274 :       LACHAL(I)=NV2
 275 :       MLREEL=ICHPO2
 276 :       SEGACT MLREEL
 277 :       LACHAT(I)=ICHPO2
 278 :       MLREEL=ICHPO3
 279 :       SEGACT MLREEL
 280 :       LACHAF(I)=ICHPO3
 281 :       SEGDES ICHARG
 282 :   140 CONTINUE
 283 : C
 284 :       SEGDES MCHARG
 285 :       SEGSUP V0
 286 :       SEGADJ MACHAR
 287 :       KACHAR=MACHAR
 288 : C
 289 : C     CREATION DU TABLEAU IBCHA DES SEGMENTS MALIAI
 290 : C
 291 :       DO 160 INLIAI=1,NBLIPE
 292 :       MALIAI=NOMALI(INLIAI)
 293 :       MWLIAI=KWLIAI
 294 :       SEGSUP MWLIAI
 295 :       NCHAL=IT(INLIAI)
 296 :       IF(NCHAL.NE.0) THEN
 297 :         NL=NDCLIA(/1)
 298 :         NALI=ALIA1(/1)
 299 :         NBLI=ALIA2(/1)
 300 :         NBSTLI=NLBLI(/2)
 301 :         SEGADJ MALIAI
 302 :            DO 150 ITT=1,NCHAL
 303 :            IBCHA(ITT)=ITLIA(ITT,INLIAI)
 304 :   150      CONTINUE
 305 :       ENDIF
 306 :   160 CONTINUE
 307 :       SEGSUP IT,ITLI
 308 : C
 309 :       IF(IIMPI.EQ.1) THEN
 310 :         DO 210 INLIAI=1,NBLIPE
 311 :         MALIAI=NOMALI(INLIAI)
 312 :         NCHAL=IBCHA(/1)
 313 :         WRITE(IOIMP,1001) INLIAI,NCHAL
 314 :  1001 FORMAT(/1X,' LA ',I5,' IEME LIAISON EST CHARGEE AVEC ',I5,
 315 :      *' CHARGEMENT(S) '/)
 316 :         IF(NCHAL.NE.0) THEN
 317 :           NLS2=NDCLIA(/1)/2
 318 :           DO 200 J=1,NCHAL
 319 :           IT1=IBCHA(J)+1
 320 :           IT2=0
 321 :              DO 170 N=1,NCHAR
 322 :              IT2=IT2+LACHAL(N)
 323 :              IF(IT1.LE.IT2) THEN
 324 :                WRITE(IOIMP,1002) N,LACHAT(N),LACHAF(N),LACHAL(N)
 325 :  1002 FORMAT(//1X,' CHARGEMENT ',I5,' T, F(T) :',I6,1X,I6,1X,I6)
 326 :                GOTO 180
 327 :              ENDIF
 328 :   170        CONTINUE
 329 :   180        CONTINUE
 330 :           IT2=IT1+NLS2-1
 331 :           WRITE(IOIMP,1003)(BCHAR1(IT),IT=IT1,IT2)
 332 :  1003 FORMAT(1X,10(1PE12.5,1X))
 333 :   200     CONTINUE
 334 :         ENDIF
 335 :   210   CONTINUE
 336 :       ENDIF
 337 : C
 338 :       WRITE(IOIMP,*) 'FIN DE ELFCHA'
 339 :       RETURN
 340 :       END
 341 :  
 342 :  
 343 :  
 344 :  

© Cast3M 2003 - All rights reserved.
Disclaimer