C++++++  DEBUT FIGURE 6.10
C                                                                       MEF    1
C=======================================================================MEF    2
C                                                                       MEF    3
C     PROGRAMME  M . E . F .  - 3 -   VERSION  'LIVRE'   OCTOBRE 1979   MEF    4
C       ( G.TOUZOT , G.DHATT )                                          MEF    5
C     PROGRAMME PRINCIPAL                                               MEF    6
C                                                                       MEF    7
C=======================================================================MEF    8
      IMPLICIT REAL*8(A-H,O-Z)                                          MEF    9
      REAL*4 BLOC,BLOCS                                                 MEF   10
      COMMON/ALLOC/NVA,IVA,IVAMAX,NREEL,NTBL                            MEF   11
      COMMON/ES/M,MR,MP,MLUN(10)                                        MEF   12
      COMMON VA(20000)                                                  MEF   13
      DIMENSION BLOCS(21)                                               MEF   14
      DATA BLOCS/4HIMAG,4HCOMT,4HCOOR,4HDLPN,4HCOND,4HPRND,4HPREL,      MEF   15
     1           4HELEM,4HSOLC,4HSOLR,4HLINM,4HLIND,4HNLIN,4HTEMP,      MEF   16
     2           4HVALP,4H....,4H....,4H....,4H....,4H....,4HSTOP/      MEF   17
      DATA NB/21/                                                       MEF   18
C-----------------------------------------------------------------------MEF   19
C.......  DIMENSION DU COMMON BLANC EN MOTS REELS (TABLE VA)            MEF   20
      NVA=20000                                                         MEF   21
      OPEN(5,file='MEF.INP',type='OLD')
      OPEN(6,file='MEF.OUT',type='UNKNOWN')
C-------  EN-TETE                                                       MEF   22
      WRITE(MP,2000)                                                    MEF   23
2000  FORMAT(1H1,30X,'M.E.F.3.'/23X,' G.TOUZOT , G.DHATT'/23X,22('-')//)MEF   24
C-------  LECTURE DE L'EN-TETE D'UN BLOC                                MEF   25
10    READ(MR,1000) BLOC,M,MLUN                                         MEF   26
1000  FORMAT(A4,I6,10I5)                                                MEF   27
C-------  RECHERCHE DU BLOC A EXECUTER                                  MEF   28
      DO 20 I=1,NB                                                      MEF   29
      IF(BLOC.EQ.BLOCS(I)) GO TO 30                                     MEF   30
20      CONTINUE                                                        MEF   31
      WRITE(MP,2010)                                                    MEF   32
2010  FORMAT(' ** ERREUR, CARTE D APPEL DE BLOC MANQUANTE')             MEF   33
      GO TO 10                                                          MEF   34
30    GO TO (110,120,130,140,150,160,170,                               MEF   35
     1       180,190,200,210,220,230,240,                               MEF   36
     2       250,260,270,280,290,300,999),I                             MEF   37
C-------  BLOC D'IMPRESSION DE L'ENSEMBLE DES DONNEES      'IMAG'       MEF   38
110   CALL BLIMAG                                                       MEF   39
      GO TO 10                                                          MEF   40
C-------  BLOC DE LECTURE-IMPRESSION DE COMMENTAIRES       'COMT'       MEF   41
120   CALL BLCOMT                                                       MEF   42
      GO TO 10                                                          MEF   43
C-------  BLOC DE LECTURE DES NOEUDS                       'COOR'       MEF   44
130   CALL BLCOOR                                                       MEF   45
      GO TO 10                                                          MEF   46
C-------  BLOC DE LECTURE DES DEGRES DE LIBERTE PAR NOEUD  'DLPN'       MEF   47
140   CALL BLDLPN                                                       MEF   48
      GO TO 10                                                          MEF   49
C-------  BLOC DE LECTURE DES CONDITIONS AUX LIMITES       'COND'       MEF   50
150   CALL BLCOND                                                       MEF   51
      GO TO 10                                                          MEF   52
C-------  BLOC DE LECTURE DES PROPRIETES NODALES           'PRND'       MEF   53
160   CALL BLPRND                                                       MEF   54
      GO TO 10                                                          MEF   55
C-------  BLOC DE LECTURE DES PROPRIETES ELEMENTAIRES      'PREL'       MEF   56
170   CALL BLPREL                                                       MEF   57
      GO TO 10                                                          MEF   58
C-------  BLOC DE LECTURE DES ELEMENTS                     'ELEM'       MEF   59
180   CALL BLELEM                                                       MEF   60
      GO TO 10                                                          MEF   61
C-------  BLOC DE LECTURE DES SOLLICITATIONS CONCENTREES   'SOLC'       MEF   62
190   CALL BLSOLC                                                       MEF   63
      GO TO 10                                                          MEF   64
C-------  BLOC DE LECTURE DES SOLLICITATIONS REPARTIES     'SOLR'       MEF   65
200   CALL BLSOLR                                                       MEF   66
      GO TO 10                                                          MEF   67
C-------  BLOC D'ASSEMBLAGE-RESOLUTION LINEAIRE EN MEMOIRE 'LINM'       MEF   68
210   CALL BLLINM                                                       MEF   69
      GO TO 10                                                          MEF   70
C-------  BLOC ASSEMBLAGE-RESOLUTION LINEAIRE SUR DISQUE   'LIND'       MEF   71
220   CALL BLLIND                                                       MEF   72
      GO TO 10                                                          MEF   73
C-------  BLOC DE RESOLUTION NON LINEAIRE                  'NLIN'       MEF   74
230   CALL BLNLIN                                                       MEF   75
      GO TO 10                                                          MEF   76
C-------  BLOC DE RESOLUTION NON STATIONNAIRE              'TEMP'       MEF   77
240   CALL BLTEMP                                                       MEF   78
      GO TO 10                                                          MEF   79
C-------  BLOC DE CALCUL DE VALEURS PROPRES (SOUS ESPACE)  'VALP'       MEF   80
250   CALL BLVALP                                                       MEF   81
      GO TO 10                                                          MEF   82
C-------  BLOCS NON DEFINIS                                             MEF   83
260   CONTINUE                                                          MEF   84
270   CONTINUE                                                          MEF   85
280   CONTINUE                                                          MEF   86
290   CONTINUE                                                          MEF   87
300   CONTINUE                                                          MEF   88
      GO TO 10                                                          MEF   89
C-------  FIN DU PROBLEME                                  'STOP'       MEF   90
999   WRITE(MP,2020) IVAMAX,NVA                                         MEF   91
2020  FORMAT(//' FIN DU PROBLEME, ',I10,' MOTS REELS UTILISES SUR ',I10)MEF   92
      STOP                                                              MEF   93
      END                                                               MEF   94
                                                                                
      BLOCK DATA                                                        BLOC   1
C=======================================================================BLOC   2
C     INITIALISATION DES COMMONS ETIQUETES                              BLOC   3
C=======================================================================BLOC   4
      IMPLICIT REAL*8(A-H,O-Z)                                          BLOC   5
      COMMON/COOR/NDIM,NNT,NDLN,NDLT,FAC(3)                             BLOC   6
      COMMON/COND/NCLT,NCLZ,NCLNZ                                       BLOC   7
      COMMON/PRND/NPRN                                                  BLOC   8
      COMMON/PREL/NGPE,NPRE                                             BLOC   9
      COMMON/ELEM/NELT,NNEL,NTPE,NGRE,ME,NIDENT,NPG                     BLOC  10
      COMMON/ASSE/NSYM,NKG,NKE,NDLE                                     BLOC  11
      COMMON/RESO/NEQ,NRES,MRES                                         BLOC  12
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,   BLOC  13
     1  IPG,ICOD,IDLE0,INEL0,IPG0                                       BLOC  14
      COMMON/LIND/NLBL,NBLM,MKG1,MKG2                                   BLOC  15
      COMMON/NLIN/EPSDL,XNORM,OMEGA,XPAS,DPAS,DPAS0,NPAS,IPAS,NITER,    BLOC  16
     1  ITER,IMETH                                                      BLOC  17
      COMMON/VALP/NITER1,NMDIAG,EPSLB,SHIFT,NSS,NSWM,TOLJAC,NVALP       BLOC  18
      COMMON/ES/M,MR,MP,MLUN(10)                                        BLOC  19
      COMMON/ALLOC/NVA,IVA,IVAMAX,NREEL,NTBL                            BLOC  20
      COMMON/LOC/LCORG,LDLNC,LNEQ,LDIMP,LPRNG,LPREG,LLD,LLOCE,LCORE,LNE,BLOC  21
     1  LPRNE,LPREE,LDLE,LKE,LFE,LKGS,LKGD,LKGI,LFG,LRES,LDLG,LME,      BLOC  22
     2  LDLE0,LDLG0,LFG0                                                BLOC  23
      DIMENSION LXX(25)                                                 BLOC  24
      EQUIVALENCE (LXX(1),LCORG)                                        BLOC  25
C-------  COMMON /COOR/                                                 BLOC  26
      DATA NNT/20/,NDLN/2/,NDIM/2/,FAC/3*1.D0/                          BLOC  27
C-------  COMMON /PRND/                                                 BLOC  28
      DATA NPRN/0/                                                      BLOC  29
C-------  COMMON /PREL/                                                 BLOC  30
      DATA NGPE/0/,NPRE/0/                                              BLOC  31
C-------  COMMON /ELEM/                                                 BLOC  32
      DATA NELT/20/,NNEL/8/,NTPE/1/,NGRE/1/,ME/1/,NIDENT/0/             BLOC  33
C-------  COMMON/ASSE/                                                  BLOC  34
      DATA NSYM/0/                                                      BLOC  35
C-------  COMMON /RESO/                                                 BLOC  36
      DATA NRES/0/,MRES/2/                                              BLOC  37
C-------  COMMON /RGDT/                                                 BLOC  38
      DATA ITPE1/0/                                                     BLOC  39
C-------  COMMON /LIND/                                                 BLOC  40
      DATA MKG1/4/,MKG2/7/                                              BLOC  41
C-------  COMMON /NLIN/                                                 BLOC  42
      DATA EPSDL/1.D-2/,OMEGA/1.D0/,DPAS/.2D0/,NPAS/1/,NITER/5/,IMETH/1/BLOC  43
C-------  COMMON /VALP/                                                 BLOC  44
      DATA NITER1/10/,NMDIAG/0/,EPSLB/1.D-3/,SHIFT/0.D0/,NSS/5/,        BLOC  45
     1  NSWM/12/,TOLJAC/1.D-12/,NVALP/3/                                BLOC  46
C-------  COMMON /ES/                                                   BLOC  47
      DATA MR/5/,MP/6/                                                  BLOC  48
C-------  COMMON /ALLOC/                                                BLOC  49
      DATA IVA/1/,IVAMAX/1/,NTBL/25/                                    BLOC  50
C.......  DEFINIR ICI LE NOMBRE D'ENTIERS CONTENUS DANS UN REEL         BLOC  51
C         SUR LE CALCULATEUR UTILISE                                    BLOC  52
C           EXEMPLES:  IBM   SIMPLE PRECISION    NREEL.EQ.1             BLOC  53
C                      IBM   DOUBLE PRECISION    NREEL.EQ.2             BLOC  54
C                      CDC                       NREEL.EQ.1             BLOC  55
      DATA NREEL/2/                                                     BLOC  56
C.......                                                                BLOC  57
C-------  COMMON /LOC/                                                  BLOC  58
      DATA LXX/25*1/                                                    BLOC  59
      END                                                               BLOC  60
 
      SUBROUTINE ERREUR(IERR,I1,I2,INIV)                                ERRE   1
C=======================================================================ERRE   2
C     IMPRESSION DES ERREURS DANS LES BLOCS DE LECTURE DES DONNEES      ERRE   3
C=======================================================================ERRE   4
      COMMON/ES/M,MR,MP                                                 ERRE   5
C-----------------------------------------------------------------------ERRE   6
C-------  BLOC 'COOR'                                                   ERRE   7
      IF(IERR.GT.19) GO TO 200                                          ERRE   8
      IE=IERR-10                                                        ERRE   9
      GO TO (110,120,130,140,150,160,160,180),IE                        ERRE  10
110   WRITE(MP,2110)I1,I2                                               ERRE  11
2110  FORMAT(' *** ERREUR, LE NUMERO DU PREMIER NOEUD(',I4,') EST SUPERIERRE  12
     1EUR A NNT=',I4)                                                   ERRE  13
      GO TO 900                                                         ERRE  14
120   WRITE(MP,2120)I1,I2                                               ERRE  15
2120  FORMAT(' ** ERREUR, LE NUMERO DU SECOND NOEUD(',I4,') EST SUPERIEUERRE  16
     1R A NNT=',I4)                                                     ERRE  17
      GO TO 900                                                         ERRE  18
130   WRITE(MP,2130)I1,I2                                               ERRE  19
2130  FORMAT(' ** ERREUR, LE NOMBRE DE D.L. DU NOEUD(',I4,') EST SUPERIEERRE  20
     1UR A NDLN=',I4)                                                   ERRE  21
      GO TO 900                                                         ERRE  22
140   WRITE(MP,2140)                                                    ERRE  23
2140  FORMAT(' ** ERREUR, LES NUMEROS DU PREMIER ET DU SECOND NOEUDS SONERRE  24
     1T INCOMPATIBLES AVEC L INCREMENT DE GENERATION')                  ERRE  25
      GO TO 900                                                         ERRE  26
150   WRITE(MP,2150)I1                                                  ERRE  27
2150  FORMAT(' ** ERREUR, LE NOEUD ',I4,' EST DEFINI PLUSIEURS FOIS')   ERRE  28
      GO TO 900                                                         ERRE  29
160   WRITE(MP,2160)I1                                                  ERRE  30
2160  FORMAT(' ** ERREUR, LE NOEUD ',I4,' N EST PAS DEFINI')            ERRE  31
      GO TO 900                                                         ERRE  32
180   WRITE(MP,2180)I2,I1                                               ERRE  33
2180  FORMAT(' ** ERREUR, LE NOMBRE DE NOEUDS CREES(',I4,') EST INFERIEUERRE  34
     1R A NNT=',I4)                                                     ERRE  35
      GO TO 900                                                         ERRE  36
C-------  BLOC 'DLPN'                                                   ERRE  37
200   IF(IERR.GT.29) GO TO 300                                          ERRE  38
      IE=IERR-20                                                        ERRE  39
      GO TO (210,220),IE                                                ERRE  40
210   WRITE(MP,2210)I1,I2                                               ERRE  41
2210  FORMAT(' ** ERREUR, LE NOMBRE DE D.L. (',I2,') EST SUPERIEUR A NDLERRE  42
     1N=',I2)                                                           ERRE  43
      GO TO 900                                                         ERRE  44
220   WRITE(MP,2220)I1,I2                                               ERRE  45
2220  FORMAT(' ** ERREUR, LE NUMERO D UN NOEUD(',I4,') EST SUPERIEUR A NERRE  46
     1NT=',I4)                                                          ERRE  47
      GO TO 900                                                         ERRE  48
C-------  BLOC 'COND'                                                   ERRE  49
300   IF(IERR.GT.39)GO TO 400                                           ERRE  50
      IE=IERR-30                                                        ERRE  51
      GO TO (900,320,900),IE                                            ERRE  52
320   GO TO 220                                                         ERRE  53
C-------  BLOC 'PREL'                                                   ERRE  54
400   IF(IERR.GT.49) GO TO 500                                          ERRE  55
      IE=IERR-40                                                        ERRE  56
      GO TO (410,900),IE                                                ERRE  57
410   WRITE(MP,2410)I1,I2                                               ERRE  58
2410  FORMAT(' ** ERREUR, LE NUMERO DE GROUPE (',I3,') EST SUPERIEUR A NERRE  59
     1GPE=',I3)                                                         ERRE  60
      GO TO 900                                                         ERRE  61
C-------  BLOC 'ELEM'                                                   ERRE  62
500   IF(IERR.GT.59) GO TO 900                                          ERRE  63
      IE=IERR-50                                                        ERRE  64
      GO TO (510,900,530,540,550,560,570),IE                            ERRE  65
510   WRITE(MP,2510)I1,I2                                               ERRE  66
2510  FORMAT(' ** ERREUR, LE NOMBRE DE NOEUDS(',I3,') EST SUPERIEUR A NNERRE  67
     1EL=',I3)                                                          ERRE  68
      GO TO 900                                                         ERRE  69
530   WRITE(MP,2530)I1,I2                                               ERRE  70
2530  FORMAT(' ** ERREUR, NUMERO DE PROPRIETE (',I3,') SUPERIEUR A NGPE=ERRE  71
     1',I3)                                                             ERRE  72
      GO TO 900                                                         ERRE  73
540   WRITE(MP,2540)I1,I2                                               ERRE  74
2540  FORMAT(' ** ERREUR, NUMERO DE GROUPE (',I3,') SUPERIEUR A NGRE=', ERRE  75
     1I3)                                                               ERRE  76
      GO TO 900                                                         ERRE  77
550   WRITE(MP,2550)I1,I2                                               ERRE  78
2550  FORMAT(' ** ERREUR, NUMERO D ELEMENT (',I4,') SUPERIEUR A NELT=', ERRE  79
     1I4)                                                               ERRE  80
      GO TO 900                                                         ERRE  81
560   GO TO 220                                                         ERRE  82
570   WRITE(MP,2570)I1,I2                                               ERRE  83
2570  FORMAT(' ** ERREUR, NOMBRE D ELEMENTS (',I4,') SUPERIEUR A NELT=',ERRE  84
     1I4)                                                               ERRE  85
C-------  FIN                                                           ERRE  86
900   I1=I2                                                             ERRE  87
      IF(INIV.GE.2) STOP                                                ERRE  88
      RETURN                                                            ERRE  89
      END                                                               ERRE  90
C++++++  FIN FIGURE 6.10
C++++++  DEBUT FIGURE 6.5                                                       
      SUBROUTINE ESPACE(ILONG,IREEL,TBL,IDEB)                           ESPA   1
C=======================================================================ESPA   2
C     ALLOCATION D'UNE TABLE REELLE OU ENTIERE DANS LA TABLE VA         ESPA   3
C       ENTREES                                                         ESPA   4
C          ILONG             LONGUEUR DE LA TABLE A CREER               ESPA   5
C                            (EN MOTS REELS OU ENTIERS)                 ESPA   6
C          IREEL             TYPE DE LA TABLE :                         ESPA   7
C                                 .EQ.0     ENTIERE                     ESPA   8
C                                 .EQ.1     REELLE                      ESPA   9
C          TBL               NOM DE LA TABLE (A4)                       ESPA  10
C       SORTIE                                                          ESPA  11
C          IDEB              LA TABLE CREEE DEBUTE EN VA(IDEB)          ESPA  12
C=======================================================================ESPA  13
      IMPLICIT REAL*8(A-H,O-Z)                                          ESPA  14
      REAL*4 TBL                                                        ESPA  15
      COMMON/ES/M,MR,MP                                                 ESPA  16
      COMMON/ALLOC/NVA,IVA,IVAMAX,NREEL                                 ESPA  17
      COMMON VA(1)                                                      ESPA  18
      DIMENSION KA(1)                                                   ESPA  19
      EQUIVALENCE (VA(1),KA(1))                                         ESPA  20
      DATA ZERO/0.D0/                                                   ESPA  21
C-----------------------------------------------------------------------ESPA  22
C-------  CALCULER LA LONGUEUR DE LA TABLE EN MOTS REELS                ESPA  23
      ILGR=ILONG                                                        ESPA  24
      IF(IREEL.EQ.0) ILGR=(ILONG+NREEL-1)/NREEL                         ESPA  25
      IVA1=IVA+ILGR                                                     ESPA  26
C-------  VERIFIER SI L'ESPACE EST DISPONIBLE                           ESPA  27
      IF(IVA1.LE.NVA) GO TO 20                                          ESPA  28
C.......  EXTENSION AUTOMATIQUE DU COMMON BLANC SI LA COMMANDE          ESPA  29
C         SYSTEME CORRESPONDANTE EXISTE SUR LE CALCULATEUR UTILISE      ESPA  30
C     CALL EXTEND(IVA1,IERR)                                            ESPA  31
C     IF(IERR.EQ.1) GO TO 10                                            ESPA  32
C     NVA=IVA1                                                          ESPA  33
C     GO TO 20                                                          ESPA  34
C-------  ERREUR D'ALLOCATION (MANQUE D'ESPACE)                         ESPA  35
10    WRITE(MP,2000) TBL,IVA1,NVA                                       ESPA  36
2000  FORMAT(' **** ERREUR D ALLOCATION, TABLE ',A4/' ESPACE REQUIS:',I9ESPA  37
     1,' MOTS REELS, ESPACE DISPONIBLE:',I9,' MOTS REELS')              ESPA  38
      STOP                                                              ESPA  39
C-------  ALLOCATION DE LA TABLE                                        ESPA  40
20    IDEB=IVA+1                                                        ESPA  41
      IVA=IVA1                                                          ESPA  42
      IF(IVA.GT.IVAMAX) IVAMAX=IVA                                      ESPA  43
      IF(M.GT.0) WRITE(MP,2010) TBL,IDEB,IVA1                           ESPA  44
2010  FORMAT(60X,'TABLE ',A4,' PLACEE DE VA(',I7,') A VA(',I7,')')      ESPA  45
C-------  INITIALISATION A ZERO DE LA TABLE CREEE                       ESPA  46
      I1=IDEB                                                           ESPA  47
      IF(IREEL.EQ.0) I1=(I1-1)*NREEL+1                                  ESPA  48
      I2=I1+ILONG-1                                                     ESPA  49
      IF(IREEL.EQ.0) GO TO 40                                           ESPA  50
      DO 30 I=I1,I2                                                     ESPA  51
30    VA(I)=ZERO                                                        ESPA  52
      RETURN                                                            ESPA  53
40    DO 50 I=I1,I2                                                     ESPA  54
50    KA(I)=0                                                           ESPA  55
      RETURN                                                            ESPA  56
      END                                                               ESPA  57
                                                                                
      SUBROUTINE VIDE(IDEB,IREEL,TBL)                                   VIDE   1
C=======================================================================VIDE   2
C     SUPPRESSION D'UNE TABLE SITUEE DANS VA, AVEC COMPACTAGE           VIDE   3
C       ENTREE                                                          VIDE   4
C          IDEB              POSITION DU DEBUT DE LA TABLE A DETRUIRE   VIDE   5
C          IREEL             TYPE DE LA TABLE (VOIR ESPACE)             VIDE   6
C          TBL               NOM DE LA TABLE (A4)                       VIDE   7
C=======================================================================VIDE   8
      IMPLICIT REAL*8(A-H,O-Z)                                          VIDE   9
      REAL*4 TBL                                                        VIDE  10
      COMMON/ES/M,MR,MP                                                 VIDE  11
      COMMON/ALLOC/NVA,IVA,IVAMAX,NREEL,NTBL                            VIDE  12
      COMMON/LOC/LXX(25)                                                VIDE  13
      COMMON VA(1)                                                      VIDE  14
C-----------------------------------------------------------------------VIDE  15
C-------  RECHERCHE DU DEBUT DE LA TABLE SUIVANTE                       VIDE  16
      I1=IVA+1                                                          VIDE  17
      DO 10 I=1,NTBL                                                    VIDE  18
      IF(LXX(I).LE.IDEB) GO TO 10                                       VIDE  19
      IF(LXX(I).LT.I1) I1=LXX(I)                                        VIDE  20
10    CONTINUE                                                          VIDE  21
C-------  DECALAGE DES TABLES SUIVANTES                                 VIDE  22
      ID=I1-IDEB                                                        VIDE  23
      IF(I1.EQ.IVA+1) GO TO 40                                          VIDE  24
      DO 20 I=1,NTBL                                                    VIDE  25
      IF(LXX(I).GT.IDEB) LXX(I)=LXX(I)-ID                               VIDE  26
20    CONTINUE                                                          VIDE  27
      DO 30 I=I1,IVA                                                    VIDE  28
      J=I-ID                                                            VIDE  29
30    VA(J)=VA(I)                                                       VIDE  30
C-------  IMPRESSION                                                    VIDE  31
40    IVA=IVA-ID                                                        VIDE  32
      IF(M.GT.0) WRITE(MP,2000) TBL,ID,IDEB                             VIDE  33
2000  FORMAT(60X,'SUPPRESSION TABLE ',A4,' COMPACTAGE ',I7,' MOTS REELS VIDE  34
     1APRES VA(',I7,')')                                                VIDE  35
      RETURN                                                            VIDE  36
      END                                                               VIDE  37
C++++++  FIN FIGURE 6.5                                                         
C++++++  DEBUT FIGURE 6.11
      SUBROUTINE BLIMAG                                                 BLIM   1
C=======================================================================BLIM   2
C     APPEL ET EXECUTION DU BLOC 'IMAG'                                 BLIM   3
C     IMPRESSION DE L'ENSEMBLE DES CARTES DE DONNEES                    BLIM   4
C=======================================================================BLIM   5
      IMPLICIT REAL*8(A-H,O-Z)                                          BLIM   6
      COMMON/ES/M,MR,MP,M1                                              BLIM   7
      COMMON/TRVL/CART(20)                                              BLIM   8
      DATA ICARTM/40/                                                   BLIM   9
C-----------------------------------------------------------------------BLIM  10
      IF(M1.EQ.0) M1=MR                                                 BLIM  11
      WRITE(MP,2000)                                                    BLIM  12
2000  FORMAT(///,1X,'IMAGE DES DONNEES SUR CARTES'/1X,28('='),/)        BLIM  13
      WRITE(MP,2005)                                                    BLIM  14
2005  FORMAT(/                                                          BLIM  15
     1  50X,'N U M E R O   D E   C O L O N N E',/,13X,'NUMERO',6X,      BLIM  16
     2  10X,'1',9X,'2',9X,'3',9X,'4',9X,'5',9X,'6',9X,'7',9X,'8',/,     BLIM  17
     3  12X,'DE CARTE',6X,8('1234567890'),/,12X,8('-'),6X,80('-'))      BLIM  18
      ICART=0                                                           BLIM  19
      ICART1=0                                                          BLIM  20
10    READ(M1,1000,END=30) CART                                         BLIM  21
1000  FORMAT(20A4)                                                      BLIM  22
      ICART=ICART+1                                                     BLIM  23
      ICART1=ICART1+1                                                   BLIM  24
      IF(ICART1.LE.ICARTM) GO TO 20                                     BLIM  25
      WRITE(MP,2010)                                                    BLIM  26
2010  FORMAT(12X,8(1H-),6X,80(1H-),/,13X,'NUMERO',7X,8('1234567890'),/, BLIM  27
     1  12X,'DE CARTE',6X,9X,'1',9X,'2',9X,'3',9X,'4',9X,'5',9X,'6',    BLIM  28
     2  9X,'7',9X,'8',/,50X,'N U M E R O   D E   C O L O N N E')        BLIM  29
      WRITE(MP,2015)                                                    BLIM  30
2015  FORMAT(1H1,//)                                                    BLIM  31
      WRITE(MP,2005)                                                    BLIM  32
      ICART1=0                                                          BLIM  33
20    WRITE(MP,2020) ICART,CART                                         BLIM  34
2020  FORMAT(10X,I10,6X,20A4)                                           BLIM  35
      GO TO 10                                                          BLIM  36
30    WRITE(MP,2010)                                                    BLIM  37
      WRITE(MP,2030)                                                    BLIM  38
2030  FORMAT(///,51X,'F I N   D E S   D O N N E E S',/,1H1)             BLIM  39
      REWIND M1                                                         BLIM  40
      READ(M1,1000) CART                                                BLIM  41
      RETURN                                                            BLIM  42
      END                                                               BLIM  43
C++++++  FIN FIGURE 6.11
C++++++  DEBUT FIGURE 6.12
      SUBROUTINE BLCOMT                                                 BLCM   1
C=======================================================================BLCM   2
C     APPEL ET EXECUTION DU BLOC 'COMT'                                 BLCM   3
C=======================================================================BLCM   4
      IMPLICIT REAL*8(A-H,O-Z)                                          BLCM   5
      REAL*4 BLANC,CART                                                 BLCM   6
      COMMON/ES/M,MR,MP                                                 BLCM   7
      COMMON/TRVL/CART(20)                                              BLCM   8
      DATA BLANC/4H    /                                                BLCM   9
C-----------------------------------------------------------------------BLCM  10
      WRITE(MP,2000)                                                    BLCM  11
2000  FORMAT(//' COMMENTAIRES'/' ',13('=')/)                            BLCM  12
C-------  LECTURE D'UNE CARTE DE COMMENTAIRE                            BLCM  13
10    READ(MR,1000) CART                                                BLCM  14
1000  FORMAT(20A4)                                                      BLCM  15
C-------  RECHERCHE D'UNE CARTE ENTIEREMENT BLANCHE                     BLCM  16
      DO 20 I=1,20                                                      BLCM  17
      IF(CART(I).NE.BLANC) GO TO 30                                     BLCM  18
20    CONTINUE                                                          BLCM  19
      RETURN                                                            BLCM  20
30    WRITE(MP,2010) CART                                               BLCM  21
2010  FORMAT(1X,20A4)                                                   BLCM  22
      GO TO 10                                                          BLCM  23
      END                                                               BLCM  24
C++++++  FIN FIGURE 6.12
C++++++  DEBUT FIGURE 6.13
      SUBROUTINE BLCOOR                                                 BLCR   1
C=======================================================================BLCR   2
C     APPEL DU BLOC 'COOR'                                              BLCR   3
C     LECTURE DES COORDONNEES DES NOEUDS                                BLCR   4
C=======================================================================BLCR   5
      IMPLICIT REAL*8(A-H,O-Z)                                          BLCR   6
      REAL*4 TBL                                                        BLCR   7
      COMMON/COOR/NDIM,NNT,NDLN,NDLT,FAC(3)                             BLCR   8
      COMMON/ES/M,MR,MP,M1                                              BLCR   9
      COMMON/ALLOC/NVA                                                  BLCR  10
      COMMON/LOC/LCORG,LDLNC                                            BLCR  11
      COMMON/TRVL/FAC1(3),IN(3)                                         BLCR  12
      COMMON VA(1)                                                      BLCR  13
      DIMENSION TBL(2)                                                  BLCR  14
      DATA ZERO/0.D0/,TBL/4HCORG,4HDLNC/                                BLCR  15
C-----------------------------------------------------------------------BLCR  16
C-------  EN-TETE DE BLOC                                               BLCR  17
      IF(M1.EQ.0) M1=MR                                                 BLCR  18
      READ(M1,1000) IN,FAC1                                             BLCR  19
1000  FORMAT(3I5,3F10.0)                                                BLCR  20
C-------  OPTIONS PAR DEFAUT                                            BLCR  21
      IF(IN(1).GT.0) NNT=IN(1)                                          BLCR  22
      IF(IN(2).GT.0) NDLN=IN(2)                                         BLCR  23
      IF(IN(3).GT.0) NDIM=IN(3)                                         BLCR  24
      DO 10 I=1,3                                                       BLCR  25
      IF(FAC1(I).NE.ZERO) FAC(I)=FAC1(I)                                BLCR  26
10    CONTINUE                                                          BLCR  27
C-------  IMPRESSION DES PARAMETRES DU BLOC                             BLCR  28
      WRITE(MP,2000) M,NNT,NDLN,NDIM,FAC,NVA                            BLCR  29
2000  FORMAT(//' LECTURE DES NOEUDS (M=',I2,')'/' ',18('=')/            BLCR  30
     1  15X,'NOMBRE MAX. DE NOEUDS               (NNT)=',I5/            BLCR  31
     2  15X,'NOMBRE MAX. DE D.L. PAR NOEUD      (NDLN)=',I5/            BLCR  32
     3  15X,'NOMBRE DE DIMENSIONS DU PROBLEME   (NDIM)=',I5/            BLCR  33
     4  15X,'FACTEUR D ECHELLE DES COORDONNEES   (FAC)=',3E12.5/        BLCR  34
     5  15X,'ESPACE DE TRAVAIL EN MOTS REELS     (NVA)=',I10)           BLCR  35
C-------  ALLOCATION D'ESPACE                                           BLCR  36
      IF(LCORG.EQ.1) CALL ESPACE(NNT*NDIM,1,TBL(1),LCORG)               BLCR  37
      IF(LDLNC.EQ.1) CALL ESPACE(NNT+1,0,TBL(2),LDLNC)                  BLCR  38
C-------  EXECUTION DU BLOC                                             BLCR  39
      CALL EXCOOR(VA(LCORG),VA(LDLNC))                                  BLCR  40
      RETURN                                                            BLCR  41
      END                                                               BLCR  42
 
      SUBROUTINE EXCOOR(VCORG,KDLNC)                                    EXCR   1
C=======================================================================EXCR   2
C     EXECUTION DU BLOC 'COOR'                                          EXCR   3
C     LECTURE DES COORDONNEES DES NOEUDS                                EXCR   4
C=======================================================================EXCR   5
      IMPLICIT REAL*8(A-H,O-Z)                                          EXCR   6
      COMMON/COOR/NDIM,NNT,NDLN,NDLT,FAC(3)                             EXCR   7
      COMMON/ES/M,MR,MP,M1                                              EXCR   8
      COMMON/TRVL/X1(3),X2(3)                                           EXCR   9
      DIMENSION VCORG(1),KDLNC(1)                                       EXCR  10
      DATA SPECL/1.23456789D31/                                         EXCR  11
C-----------------------------------------------------------------------EXCR  12
C-------  INITIALISATION DES COORDONNEES                                EXCR  13
      I1=(NNT-1)*NDIM+1                                                 EXCR  14
      DO 10 I=1,I1,NDIM                                                 EXCR  15
10    VCORG(I)=SPECL                                                    EXCR  16
C-------  LECTURE DES CARTES DE NOEUDS                                  EXCR  17
      IF(M.GT.0) WRITE(MP,2000)                                         EXCR  18
2000  FORMAT(//' CARTES DE NOEUDS'/)                                    EXCR  19
20    READ(M1,1000) IN1,X1,IN2,X2,INCR,IDLN                             EXCR  20
1000  FORMAT(2(I5,3F10.0),2I5)                                          EXCR  21
      IF(M.GT.0) WRITE(MP,2010) IN1,X1,IN2,X2,INCR,IDLN                 EXCR  22
2010  FORMAT(' >>>>>',2(I5,3E12.5),2I5)                                 EXCR  23
      IF(IN1.LE.0) GO TO 60                                             EXCR  24
C-------  DECODAGE DE LA CARTE                                          EXCR  25
      IF(IN1.GT.NNT) CALL ERREUR(11,IN1,NNT,0)                          EXCR  26
      IF(IN2.GT.NNT) CALL ERREUR(12,IN2,NNT,0)                          EXCR  27
      IF(IN2.LE.0) IN2=IN1                                              EXCR  28
      IF(IDLN.GT.NDLN) CALL ERREUR(13,IDLN,NDLN,0)                      EXCR  29
      IF(IDLN.LE.0) IDLN=NDLN                                           EXCR  30
      IF(INCR.EQ.0) INCR=1                                              EXCR  31
      I1=(IN2-IN1)/INCR                                                 EXCR  32
      I2=IN1+I1*INCR                                                    EXCR  33
      IF(I1.EQ.0)I1=1                                                   EXCR  34
      IF(IN2.NE.I2) CALL ERREUR(14,IN2,IN2,0)                           EXCR  35
C-------  GENERATION DES NOEUDS PAR INTERPOLATION                       EXCR  36
      DO 30 I=1,NDIM                                                    EXCR  37
      X1(I)=X1(I)*FAC(I)                                                EXCR  38
      X2(I)=X2(I)*FAC(I)                                                EXCR  39
30    X2(I)=(X2(I)-X1(I))/I1                                            EXCR  40
      I1=0                                                              EXCR  41
      I2=(IN1-1)*NDIM+1                                                 EXCR  42
      I3=(INCR-1)*NDIM                                                  EXCR  43
      DO 50 IN=IN1,IN2,INCR                                             EXCR  44
      KDLNC(IN+1)=IDLN                                                  EXCR  45
      IF(VCORG(I2).NE.SPECL) CALL ERREUR(15,IN,IN,0)                    EXCR  46
      DO 40 I=1,NDIM                                                    EXCR  47
      VCORG(I2)=X1(I)+X2(I)*I1                                          EXCR  48
40    I2=I2+1                                                           EXCR  49
      I1=I1+1                                                           EXCR  50
50    I2=I2+I3                                                          EXCR  51
      GO TO 20                                                          EXCR  52
C-------  VERIFICATION DES NOEUDS MANQUANTS                             EXCR  53
60    I1=NNT*NDIM+1                                                     EXCR  54
      I2=0                                                              EXCR  55
      I3=NNT+1                                                          EXCR  56
      DO 90 I=1,NNT                                                     EXCR  57
      I1=I1-NDIM                                                        EXCR  58
      I3=I3-1                                                           EXCR  59
      IF(VCORG(I1)-SPECL) 70,80,70                                      EXCR  60
70    IF(I2.EQ.0) I2=I3                                                 EXCR  61
      GO TO 90                                                          EXCR  62
80    IF(I2.EQ.0) CALL ERREUR(16,I3,I3,0)                               EXCR  63
      IF(I2.NE.0) CALL ERREUR(17,I3,I3,1)                               EXCR  64
90    CONTINUE                                                          EXCR  65
      IF(I2.NE.NNT) CALL ERREUR(18,NNT,I2,0)                            EXCR  66
C-------  NOMBRE TOTAL DE D.L.                                          EXCR  67
      NDLT=0                                                            EXCR  68
      I1=NNT+1                                                          EXCR  69
      DO 100 I=2,I1                                                     EXCR  70
100   NDLT=NDLT+KDLNC(I)                                                EXCR  71
C-------  IMPRESSIONS                                                   EXCR  72
      IF(M.LT.2) GO TO 120                                              EXCR  73
      WRITE(MP,2020)                                                    EXCR  74
2020  FORMAT(/10X,'NOEUD D.L.',5X,'X',11X,'Y',11X,'Z'/)                 EXCR  75
      I1=1                                                              EXCR  76
      I2=NDIM                                                           EXCR  77
      DO 110 IN=1,NNT                                                   EXCR  78
      WRITE(MP,2030) IN,KDLNC(IN+1),(VCORG(I),I=I1,I2)                  EXCR  79
2030  FORMAT(10X,2I5,3E12.5)                                            EXCR  80
      I1=I1+NDIM                                                        EXCR  81
110   I2=I2+NDIM                                                        EXCR  82
120   RETURN                                                            EXCR  83
      END                                                               EXCR  84
C++++++  FIN FIGURE 6.13
C++++++  DEBUT FIGURE 6.14
      SUBROUTINE BLDLPN                                                 BLDL   1
C=======================================================================BLDL   2
C     APPEL DU BLOC 'DLPN'                                              BLDL   3
C     LECTURE DES NOMBRES DE D.L. PAR NOEUD                             BLDL   4
C=======================================================================BLDL   5
      IMPLICIT REAL*8(A-H,O-Z)                                          BLDL   6
      COMMON/ES/M,MR,MP,M1                                              BLDL   7
      COMMON/LOC/LCORG,LDLNC                                            BLDL   8
      COMMON VA(1)                                                      BLDL   9
C-----------------------------------------------------------------------BLDL  10
      IF(M1.EQ.0) M1=MR                                                 BLDL  11
      WRITE(MP,2000) M                                                  BLDL  12
2000  FORMAT(//' LECTURE DES D.L. (M=',I2,')'/' ',17('='))              BLDL  13
      CALL EXDLPN(VA(LDLNC))                                            BLDL  14
      RETURN                                                            BLDL  15
      END                                                               BLDL  16
 
      SUBROUTINE EXDLPN(KDLNC)                                          EXDL   1
C=======================================================================EXDL   2
C     EXECUTION DU BLOC 'DLPN'                                          EXDL   3
C     LECTURE DES NOMBRES DE D.L. PAR NOEUD                             EXDL   4
C=======================================================================EXDL   5
      IMPLICIT REAL*8(A-H,O-Z)                                          EXDL   6
      COMMON/COOR/NDIM,NNT,NDLN,NDLT                                    EXDL   7
      COMMON/ES/M,MR,MP,M1                                              EXDL   8
      COMMON/TRVL/K1(15)                                                EXDL   9
      DIMENSION KDLNC(1)                                                EXDL  10
C-----------------------------------------------------------------------EXDL  11
      IF(M.GT.0) WRITE(MP,2000)                                         EXDL  12
2000  FORMAT(//' CARTES DE GROUPES DE D.L.'/)                           EXDL  13
C-------  LIRE UNE CARTE DE GROUPE                                      EXDL  14
10    READ(M1,1000) IDLN,K1                                             EXDL  15
1000  FORMAT(16I5)                                                      EXDL  16
      IF(M.GT.0) WRITE(MP,2010)IDLN,K1                                  EXDL  17
2010  FORMAT(' >>>>>',16I5)                                             EXDL  18
      IF(IDLN.LE.0) GO TO 40                                            EXDL  19
      IF(IDLN.GT.NDLN) CALL ERREUR(21,IDLN,NDLN,1)                      EXDL  20
C-------  STOCKER LES NOMBRES DE D.L.                                   EXDL  21
20    DO 30 I=1,15                                                      EXDL  22
      J=K1(I)                                                           EXDL  23
      IF(J.LE.0) GO TO 10                                               EXDL  24
      IF(J.GT.NNT) CALL ERREUR(22,J,NNT,1)                              EXDL  25
30    KDLNC(J+1)=IDLN                                                   EXDL  26
      READ(M1,1010) K1                                                  EXDL  27
1010  FORMAT(5X,15I5)                                                   EXDL  28
      IF(M.GT.0) WRITE(MP,2020) K1                                      EXDL  29
2020  FORMAT(' >>>>>',5X,15I5)                                          EXDL  30
      GO TO 20                                                          EXDL  31
C-------  NOMBRE TOTAL DE D.L.                                          EXDL  32
40    NDLT=0                                                            EXDL  33
      J=NNT+1                                                           EXDL  34
      DO 50 I=2,J                                                       EXDL  35
50    NDLT=NDLT+KDLNC(I)                                                EXDL  36
      RETURN                                                            EXDL  37
      END                                                               EXDL  38
C++++++  FIN FIGURE 6.14
C++++++  DEBUT FIGURE 6.15
      SUBROUTINE BLCOND                                                 BLCN   1
C=======================================================================BLCN   2
C     APPEL DU BLOC 'COND'                                              BLCN   3
C     LECTURE DES CONDITIONS AUX LIMITES ET CREATION DE LA TABLE (NEQ)  BLCN   4
C=======================================================================BLCN   5
      IMPLICIT REAL*8(A-H,O-Z)                                          BLCN   6
      REAL*4 TBL                                                        BLCN   7
      COMMON/COOR/NDIM,NNT,NDLN,NDLT                                    BLCN   8
      COMMON/COND/NCLT,NCLZ,NCLNZ                                       BLCN   9
      COMMON/ALLOC/NVA,IVA                                              BLCN  10
      COMMON/ES/M,MR,MP,M1                                              BLCN  11
      COMMON/LOC/LCORG,LDLNC,LNEQ,LDIMP                                 BLCN  12
      COMMON VA(1)                                                      BLCN  13
      DIMENSION TBL(2)                                                  BLCN  14
      DATA TBL/4HNEQ ,4HDIMP/                                           BLCN  15
C-----------------------------------------------------------------------BLCN  16
      IF(M1.EQ.0) M1=MR                                                 BLCN  17
      WRITE(MP,2000) M                                                  BLCN  18
2000  FORMAT(//' LECTURE DES CONDITIONS AUX LIMITES (M=',I2,')'/' ',    BLCN  19
     1  33('=')/)                                                       BLCN  20
      IF(LNEQ.EQ.1) CALL ESPACE(NDLT,0,TBL(1),LNEQ)                     BLCN  21
      IF(LDIMP.EQ.1) CALL ESPACE(NDLT,1,TBL(2),LDIMP)                   BLCN  22
      CALL EXCOND(VA(LCORG),VA(LDLNC),VA(LNEQ),VA(LDIMP))               BLCN  23
      CALL VIDE(LDIMP+NCLT,1,TBL(2))                                    BLCN  24
      RETURN                                                            BLCN  25
      END                                                               BLCN  26
 
      SUBROUTINE EXCOND(VCORG,KDLNC,KNEQ,VDIMP)                         EXCN   1
C=======================================================================EXCN   2
C     EXECUTION DU BLOC 'COND'                                          EXCN   3
C     LECTURE DES CONDITIONS AUX LIMITES ET CREATION DE LA TABLE (NEQ)  EXCN   4
C=======================================================================EXCN   5
      IMPLICIT REAL*8 (A-H,O-Z)                                         EXCN   6
      COMMON/COOR/NDIM,NNT,NDLN,NDLT                                    EXCN   7
      COMMON/COND/NCLT,NCLZ,NCLNZ                                       EXCN   8
      COMMON/RESO/NEQ                                                   EXCN   9
      COMMON/ES/M,MR,MP,M1                                              EXCN  10
      COMMON/TRVL/ KV(16),V(10),H(20),ICOD(10)                          EXCN  11
      DIMENSION VCORG(1),KDLNC(1),KNEQ(1),VDIMP(1)                      EXCN  12
      DATA L7/7/,L8/8/,L16/16/ ,X1/0.0D0/,X2/0.0D0/,X3/0.0D0/,ZERO/0.D0/EXCN  13
C-----------------------------------------------------------------------EXCN  14
C-------  TABLE CUMULATIVE KDLNC                                        EXCN  15
      DO 10 IN=1,NNT                                                    EXCN  16
10    KDLNC(IN+1)=KDLNC(IN)+KDLNC(IN+1)                                 EXCN  17
      I1=NNT+1                                                          EXCN  18
      IF(M.GE.2) WRITE(MP,2000) (KDLNC(IN),IN=1,I1)                     EXCN  19
2000  FORMAT(//' NOMBRE DE D.L. PRECEDANT CHAQUE NOEUD  (DLNC)'/        EXCN  20
     1  (1X,10I10))                                                     EXCN  21
C------- INITIALISATION                                                 EXCN  22
      NCLT=0                                                            EXCN  23
      NCLNZ=0                                                           EXCN  24
      NCLZ=0                                                            EXCN  25
      IF(M.GE.0) WRITE(MP,2010)                                         EXCN  26
2010  FORMAT(//' CARTES DE CONDITIONS AUX LIMITES'/)                    EXCN  27
C-------  LIRE UNE CARTE DE GROUPE DE C.L.:10 CODES + VAL.IMPOSEES      EXCN  28
20    READ(M1,1000) ICOD,(V(I),I=1,L7)                                  EXCN  29
1000  FORMAT(10I1,7F10.0)                                               EXCN  30
      IF(M.GE.0) WRITE(MP,2020) ICOD,(V(I),I=1,L7)                      EXCN  31
2020  FORMAT(' >>>>>',10I1,7E12.5)                                      EXCN  32
C-------  TEST POUR UNE CARTE BLANCHE                                   EXCN  33
      J=0                                                               EXCN  34
      DO 30 I=1,10                                                      EXCN  35
30    J=J+ICOD(I)                                                       EXCN  36
      IF(J.EQ.0) GO TO 110                                              EXCN  37
C------- LIRE UNE CARTE ADDITIONNELLE SI NECESSAIRE                     EXCN  38
      I2=0                                                              EXCN  39
      DO 40 ID=1,NDLN                                                   EXCN  40
      IF(ICOD(ID).LT.2) GO TO 40                                        EXCN  41
      I2=I2+1                                                           EXCN  42
      IF(I2.NE.L8) GO TO 40                                             EXCN  43
      READ(M1,1010) (V(I),I=L8,NDLN)                                    EXCN  44
1010  FORMAT(10X,7F10.0)                                                EXCN  45
      IF(M.GE.0) WRITE(MP,2030) (V(I),I=L8,NDLN)                        EXCN  46
2030  FORMAT(' >>>>>',10X,7E12.5)                                       EXCN  47
40    CONTINUE                                                          EXCN  48
C------- LECTURE DES CARTES DE NOEUDS                                   EXCN  49
50    READ(M1,1020) (KV(IN),IN=1,L16)                                   EXCN  50
1020  FORMAT(16I5)                                                      EXCN  51
      IF(M.GE.0) WRITE(MP,2040) (KV(IN),IN=1,L16)                       EXCN  52
2040  FORMAT(' >>>>>',10X,16I5)                                         EXCN  53
C------- CONSTRUCTION DE NEQ                                            EXCN  54
      DO 100 IN=1,L16                                                   EXCN  55
      I2=KV(IN)                                                         EXCN  56
C------- FIN DE GROUPE DE C.L. OU FIN DE NOEUDS OU ANALYSE DU NOEUD     EXCN  57
      IF(I2) 20,20,60                                                   EXCN  58
60    IF(I2.GT.NNT) CALL ERREUR(32,I2,NNT,1)                            EXCN  59
      I1=KDLNC(I2)                                                      EXCN  60
      IDN=KDLNC(I2+1)-I1                                                EXCN  61
C-------  CREER VDIMP ET PLACER DANS KNEQ L ADRESSE DU D.L. IMPOSE      EXCN  62
      IV=0                                                              EXCN  63
      DO 90 ID=1,IDN                                                    EXCN  64
      I1=I1+1                                                           EXCN  65
      IC=ICOD(ID)-1                                                     EXCN  66
      IF(IC) 90,70,80                                                   EXCN  67
70    NCLT=NCLT+1                                                       EXCN  68
      VDIMP(NCLT)=ZERO                                                  EXCN  69
      NCLZ=NCLZ+1                                                       EXCN  70
      KNEQ(I1)=-NCLT                                                    EXCN  71
      GO TO 90                                                          EXCN  72
80    NCLT=NCLT+1                                                       EXCN  73
      IV=IV+1                                                           EXCN  74
      VDIMP(NCLT)=V(IV)                                                 EXCN  75
      NCLNZ=NCLNZ+1                                                     EXCN  76
      KNEQ(I1)=-NCLT                                                    EXCN  77
90    CONTINUE                                                          EXCN  78
100   CONTINUE                                                          EXCN  79
C------- AUTRE CARTE DE NUMEROS DE NOEUDS                               EXCN  80
      GO TO 50                                                          EXCN  81
C------- CREER LES NUMEROS D'EQUATIONS DANS NEQ                         EXCN  82
110   I1=0                                                              EXCN  83
      DO 150 IN=1,NNT                                                   EXCN  84
      ID=KDLNC(IN)                                                      EXCN  85
120   ID=ID+1                                                           EXCN  86
      IF(ID.GT.KDLNC(IN+1)) GO TO 150                                   EXCN  87
      IF(KNEQ(ID)) 120,130,120                                          EXCN  88
130   I1=I1+1                                                           EXCN  89
      KNEQ(ID)=I1                                                       EXCN  90
      GO TO 120                                                         EXCN  91
150   CONTINUE                                                          EXCN  92
      NEQ=I1                                                            EXCN  93
C------- IMPRESSIONS                                                    EXCN  94
      IF(M.LT.0) GO TO 170                                              EXCN  95
      WRITE(MP,2050) NNT,NDLT,NEQ,NCLNZ,NCLZ,NCLT                       EXCN  96
2050  FORMAT(//                                                         EXCN  97
     1  15X,'NOMBRE DE NOEUDS TOTAL                       (NNT)=',I5/   EXCN  98
     2  15X,'NOMBRE DE D.L. TOTAL                        (NDLT)=',I5/   EXCN  99
     3  15X,'NOMBRE D EQUATIONS A RESOUDRE                (NEQ)=',I5/   EXCN 100
     4  15X,'NOMBRE DE D.L. IMPOSES NON NULS            (NCLNZ)=',I5/   EXCN 101
     5  15X,'NOMBRE DE D.L. IMPOSES NULS                 (NCLZ)=',I5/   EXCN 102
     6  15X,'NOMBRE TOTAL DE D.L. IMPOSES                (NCLT)=',I5/)  EXCN 103
      IF(M.GE.2.AND.NCLT.GT.0) WRITE(MP,2060)(VDIMP(I),I=1,NCLT)        EXCN 104
2060  FORMAT(//' VALEURS IMPOSEES  (VDIMP)'//(10X,10E12.5))             EXCN 105
      WRITE(MP,2070)                                                    EXCN 106
2070  FORMAT(//' TABLE DES COORDONNEES DES NOEUDS'//                    EXCN 107
     1  '   NO  D.L.',5X,'X',12X,'Y',12X,'Z',10X,'NUMEROS D EQUATIONS   EXCN 108
     2(NEQ)'/)                                                          EXCN 109
      I2=0                                                              EXCN 110
      DO 160 IN=1,NNT                                                   EXCN 111
      I1=I2+1                                                           EXCN 112
      I2=I2+NDIM                                                        EXCN 113
      ID1=KDLNC(IN)+1                                                   EXCN 114
      ID2=KDLNC(IN+1)                                                   EXCN 115
      ID=ID2-ID1+1                                                      EXCN 116
      IF(ID2.LT.ID1) ID2=ID1                                            EXCN 117
      X1=VCORG(I1)                                                      EXCN 118
      IF(NDIM.GE.2) X2=VCORG(I1+1)                                      EXCN 119
      IF(NDIM.GE.3) X3=VCORG(I1+2)                                      EXCN 120
160   WRITE(MP,2080) IN,ID,X1,X2,X3,(KNEQ(I),I=ID1,ID2)                 EXCN 121
2080  FORMAT(1X,2I5,3E12.5,10X,10I6)                                    EXCN 122
170   RETURN                                                            EXCN 123
      END                                                               EXCN 124
C++++++  FIN FIGURE 6.15
C++++++  DEBUT FIGURE 6.16
      SUBROUTINE BLPRND                                                 BLPN   1
C=======================================================================BLPN   2
C     APPEL DU BLOC 'PRND'                                              BLPN   3
C     LECTURE DES PROPRIETES NODALES                                    BLPN   4
C=======================================================================BLPN   5
      IMPLICIT REAL*8(A-H,O-Z)                                          BLPN   6
      REAL*4 TBL                                                        BLPN   7
      COMMON/COOR/NDIM,NNT                                              BLPN   8
      COMMON/PRND/NPRN                                                  BLPN   9
      COMMON/ES/M,MR,MP,M1                                              BLPN  10
      COMMON/LOC/LXX(4),LPRNG                                           BLPN  11
      COMMON VA(1)                                                      BLPN  12
      DATA TBL/4HPRNG/                                                  BLPN  13
C-----------------------------------------------------------------------BLPN  14
      IF(M1.EQ.0) M1=MR                                                 BLPN  15
      READ(M1,1000) NPRN                                                BLPN  16
1000  FORMAT(I5)                                                        BLPN  17
      WRITE(MP,2000) M,NPRN                                             BLPN  18
2000  FORMAT(//' LECTURE DES PROPRIETES NODALES (M=',I2,')'/' ',30('=')/BLPN  19
     1  15X,'NOMBRE DE PROPRIETES PAR NOEUD    (NPRN)=',I5)             BLPN  20
      IF(LPRNG.EQ.1) CALL ESPACE(NNT*NPRN,1,TBL,LPRNG)                  BLPN  21
      CALL EXPRND(VA(LPRNG))                                            BLPN  22
      RETURN                                                            BLPN  23
      END                                                               BLPN  24
 
      SUBROUTINE EXPRND(VPRNG)                                          EXPN   1
C=======================================================================EXPN   2
C     EXECUTION DU BLOC 'PRND'                                          EXPN   3
C     LECTURE DES PROPRIETES NODALES                                    EXPN   4
C=======================================================================EXPN   5
      IMPLICIT REAL*8(A-H,O-Z)                                          EXPN   6
      COMMON/COOR/NDIM,NNT                                              EXPN   7
      COMMON/PRND/NPRN                                                  EXPN   8
      COMMON/ES/M,MR,MP,M1                                              EXPN   9
      DIMENSION VPRNG(1)                                                EXPN  10
C-----------------------------------------------------------------------EXPN  11
C-------  LIRE LES PROPRIETES NOEUD APRES NOEUD                         EXPN  12
      I1=NNT*NPRN                                                       EXPN  13
      READ(M1,1000)(VPRNG(I),I=1,I1)                                    EXPN  14
1000  FORMAT(8F10.0)                                                    EXPN  15
      IF(M.GE.0) WRITE(MP,2000) (VPRNG(I),I=1,I1)                       EXPN  16
2000  FORMAT(//' CARTES DE PROPRIETES NODALES'/ (' >>>>>',8E12.5))      EXPN  17
      RETURN                                                            EXPN  18
      END                                                               EXPN  19
C++++++  FIN FIGURE 6.16
C++++++  DEBUT FIGURE 6.17
      SUBROUTINE BLPREL                                                 BLPE   1
C=======================================================================BLPE   2
C     APPEL DU BLOC 'PREL'                                              BLPE   3
C     LECTURE DES PROPRIETES ELEMENTAIRES                               BLPE   4
C=======================================================================BLPE   5
      IMPLICIT REAL*8(A-H,O-Z)                                          BLPE   6
      REAL*4 TBL                                                        BLPE   7
      COMMON/PREL/NGPE,NPRE                                             BLPE   8
      COMMON/ES/M,MR,MP,M1                                              BLPE   9
      COMMON/LOC/LXX(5),LPREG                                           BLPE  10
      COMMON/TRVL/IN(2)                                                 BLPE  11
      COMMON VA(1)                                                      BLPE  12
      DIMENSION TBL(2)                                                  BLPE  13
      DATA TBL/4HPREG,4HV   /                                           BLPE  14
C-----------------------------------------------------------------------BLPE  15
      IF(M1.EQ.0) M1=MR                                                 BLPE  16
C-------  LIRE LE NOMBRE DE GROUPES ET DE PROPRIETES PAR GROUPE         BLPE  17
      READ(M1,1000) IN                                                  BLPE  18
1000  FORMAT(2I5)                                                       BLPE  19
      IF(IN(1).GT.0) NGPE=IN(1)                                         BLPE  20
      IF(IN(2).GT.0) NPRE=IN(2)                                         BLPE  21
      WRITE(MP,2000) M,NGPE,NPRE                                        BLPE  22
2000  FORMAT(//' LECTURE DES PROPRIETES ELEMENTAIRES (M=',I2,')'/' ',   BLPE  23
     1  35('=')/15X,'NOMBRE DE GROUPES DE PROPRIETES   (NGPE)=',I5/     BLPE  24
     2  15X,'NOMBRE DE PROPRIETES PAR GROUPE   (NPRE)=',I5)             BLPE  25
      IF(LPREG.EQ.1) CALL ESPACE(NGPE*NPRE,1,TBL(1),LPREG)              BLPE  26
      CALL ESPACE(NPRE,1,TBL(2),L1)                                     BLPE  27
      CALL EXPREL(VA(LPREG),VA(L1))                                     BLPE  28
      CALL VIDE(L1,1,TBL(2))                                            BLPE  29
      RETURN                                                            BLPE  30
      END                                                               BLPE  31
 
      SUBROUTINE EXPREL(VPREG,V1)                                       EXPE   1
C=======================================================================EXPE   2
C     EXECUTION DU BLOC 'PREL'                                          EXPE   3
C     LECTURE DES PROPRIETES ELEMENTAIRES                               EXPE   4
C=======================================================================EXPE   5
      IMPLICIT REAL*8(A-H,O-Z)                                          EXPE   6
      COMMON/PREL/NGPE,NPRE                                             EXPE   7
      COMMON/ES/M,MR,MP,M1                                              EXPE   8
      DIMENSION VPREG(1),V1(1)                                          EXPE   9
C-----------------------------------------------------------------------EXPE  10
      IF(M.GE.0) WRITE(MP,2000)                                         EXPE  11
2000  FORMAT(//' CARTES DE PROPRIETES'/)                                EXPE  12
C-------  LIRE UN GROUPE                                                EXPE  13
      I1=MIN0(7,NPRE)                                                   EXPE  14
      J=1                                                               EXPE  15
10    READ(M1,1000) IGPE,(V1(I),I=1,I1)                                 EXPE  16
1000  FORMAT(I5,7F10.0)                                                 EXPE  17
      IF(M.GE.0) WRITE(MP,2010) IGPE,(V1(I),I=1,I1)                     EXPE  18
2010  FORMAT(' >>>>>',I5,7E12.5)                                        EXPE  19
      IF(IGPE.LE.0) GO TO 40                                            EXPE  20
      IF(IGPE.GT.NGPE) CALL ERREUR(41,IGPE,NGPE,1)                      EXPE  21
      IF(NPRE.LE.7) GO TO 20                                            EXPE  22
C-------  LIRE LES PROPRIETES                                           EXPE  23
      READ(M1,1010) (V1(I),I=8,NPRE)                                    EXPE  24
1010  FORMAT(5X,7F10.0)                                                 EXPE  25
      IF(M.GE.0) WRITE(MP,2020) (V1(I),I=8,NPRE)                        EXPE  26
2020  FORMAT(' >>>>>',5X,7E12.5)                                        EXPE  27
20    DO 30 I=1,NPRE                                                    EXPE  28
      VPREG(J)=V1(I)                                                    EXPE  29
30    J=J+1                                                             EXPE  30
      GO TO 10                                                          EXPE  31
40    RETURN                                                            EXPE  32
      END                                                               EXPE  33
C++++++  FIN FIGURE 6.17
C++++++  DEBUT FIGURE 6.18
      SUBROUTINE BLELEM                                                 BLEL   1
C=======================================================================BLEL   2
C     APPEL DU BLOC 'ELEM'                                              BLEL   3
C     LECTURE DES ELEMENTS                                              BLEL   4
C=======================================================================BLEL   5
      IMPLICIT REAL*8(A-H,O-Z)                                          BLEL   6
      REAL*4 TBL                                                        BLEL   7
      COMMON/COOR/NDIM,NNT,NDLN                                         BLEL   8
      COMMON/PRND/NPRN                                                  BLEL   9
      COMMON/PREL/NGPE,NPRE                                             BLEL  10
      COMMON/ELEM/NELT,NNEL,NTPE,NGRE,ME,NIDENT,NPG                     BLEL  11
      COMMON/ASSE/NSYM,NKG                                              BLEL  12
      COMMON/RESO/NEQ                                                   BLEL  13
      COMMON/ES/M,MR,MP,M1,M2                                           BLEL  14
      COMMON/LOC/LCORG,LDLNC,LNEQ,LDIMP,LPRNG,LPREG,LLD,LLOCE,LCORE,LNE,BLEL  15
     1  LPRNE,LPREE,LDLE,LKE,LFE,LKGS,LKGD,LKGI,LFG,LRES,LDLG           BLEL  16
      COMMON VA(1)                                                      BLEL  17
      DIMENSION TBL(6),IN(6)                                            BLEL  18
      DATA TBL/4HLD  ,4HLOCE,4HCORE,4HNE  ,4HPRNE,4HPREE/               BLEL  19
C-----------------------------------------------------------------------BLEL  20
      IF(M1.EQ.0) M1=MR                                                 BLEL  21
      IF(M2.EQ.0) M2=ME                                                 BLEL  22
      READ(M1,1000)IN                                                   BLEL  23
1000  FORMAT(6I5)                                                       BLEL  24
      IF(IN(1).GT.0) NELT=IN(1)                                         BLEL  25
      IF(IN(2).GT.0) NNEL=IN(2)                                         BLEL  26
      IF(IN(3).GT.0) NTPE=IN(3)                                         BLEL  27
      IF(IN(4).GT.0) NGRE=IN(4)                                         BLEL  28
      IF(IN(5).NE.0) NSYM=1                                             BLEL  29
      IF(IN(6).NE.0) NIDENT=1                                           BLEL  30
      WRITE(MP,2000) M,NELT,NNEL,NTPE,NGRE,NSYM,NIDENT                  BLEL  31
2000  FORMAT(//' LECTURE DES ELEMENTS (M=',I2,')'/' ',20('=')/          BLEL  32
     1  15X,'NOMBRE MAX. D ELEMENTS            (NELT)=',I5/             BLEL  33
     2  15X,'NOMBRE MAX. DE NOEUDS PAR ELEMENT (NNEL)=',I5/             BLEL  34
     3  15X,'TYPE D ELEMENT PAR DEFAUT         (NTPE)=',I5/             BLEL  35
     4  15X,'NOMBRE DE GROUPES D ELEMENTS      (NGRE)=',I5/             BLEL  36
     5  15X,'INDICE DE PROBLEME NON SYMETRIQUE (NSYM)=',I5/             BLEL  37
     6  15X,'INDICE D ELEMENTS IDENTIQUES    (NIDENT)=',I5/)            BLEL  38
      IF(LLD.EQ.1) CALL ESPACE(NEQ+1,0,TBL(1),LLD)                      BLEL  39
      IF(LLOCE.EQ.1) CALL ESPACE(NNEL*NDLN,0,TBL(2),LLOCE)              BLEL  40
      IF(LCORE.EQ.1) CALL ESPACE(NNEL*NDIM,1,TBL(3),LCORE)              BLEL  41
      IF(LNE.EQ.1) CALL ESPACE(NNEL,0,TBL(4),LNE)                       BLEL  42
      IF(NPRN.GT.0.AND.LPRNE.EQ.1) CALL ESPACE(NNEL*NPRN,1,TBL(5),LPRNE)BLEL  43
      IF(NPRE.GT.0.AND.LPREE.EQ.1) CALL ESPACE(NPRE,1,TBL(6),LPREE)     BLEL  44
      CALL EXELEM(VA(LCORG),VA(LDLNC),VA(LPRNG),VA(LPREG),VA(LLOCE),    BLEL  45
     1          VA(LCORE),VA(LNE),VA(LPRNE),VA(LPREE),VA(LNEQ),VA(LLD)) BLEL  46
      WRITE(MP,2010) NKG,NPG                                            BLEL  47
2010  FORMAT(15X,'LONGUEUR D UN TRIANGLE DE KG       (NKG)=',I10/       BLEL  48
     1       15X,'NOMBRE DE POINTS D INTEGRATION     (NPG)=',I10/)      BLEL  49
      RETURN                                                            BLEL  50
      END                                                               BLEL  51
 
      SUBROUTINE EXELEM(VCORG,KDLNC,VPRNG,VPREG,KLOCE,VCORE,KNE,VPRNE,  EXEL   1
     1                VPREE,KNEQ,KLD)                                   EXEL   2
C=======================================================================EXEL   3
C     EXECUTION DU BLOC 'ELEM'                                          EXEL   4
C     LECTURE DES ELEMENTS                                              EXEL   5
C=======================================================================EXEL   6
      IMPLICIT REAL*8(A-H,O-Z)                                          EXEL   7
      COMMON/COOR/NDIM,NNT                                              EXEL   8
      COMMON/PRND/NPRN                                                  EXEL   9
      COMMON/PREL/NGPE,NPRE                                             EXEL  10
      COMMON/ELEM/NELT,NNEL,NTPE,NGRE,ME,NIDENT,NPG                     EXEL  11
      COMMON/ASSE/NSYM,NKG,NKE,NDLE                                     EXEL  12
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGEXEL  13
     1  ,ICODE,IDLE0,INEL0,IPG0                                         EXEL  14
      COMMON/RESO/NEQ                                                   EXEL  15
      COMMON/ES/M,MR,MP,M1,M2                                           EXEL  16
      DIMENSION VCORG(1),KDLNC(1),VPRNG(1),VPREG(1),KLOCE(1),VCORE(1),  EXEL  17
     1          KNE(1),VPRNE(1),VPREE(1),KNEQ(1),KLD(1)                 EXEL  18
      DATA I10/10/,I15/15/                                              EXEL  19
C-----------------------------------------------------------------------EXEL  20
C-------  INITIALISATION                                                EXEL  21
      NDLE=0                                                            EXEL  22
      IELT=0                                                            EXEL  23
      NPG=0                                                             EXEL  24
      REWIND M2                                                         EXEL  25
      IF(M.GT.0) WRITE(MP,2000)                                         EXEL  26
2000  FORMAT(//' CARTES D ELEMENTS'/)                                   EXEL  27
C-------  LIRE UNE CARTE D'ELEMENT                                      EXEL  28
10    READ(M1,1000) IEL,IGEN,INCR,ITPE,IGPE,IGRE,(KNE(IN),IN=1,I10)     EXEL  29
1000  FORMAT(16I5)                                                      EXEL  30
      IF(M.GT.0) WRITE(MP,2010) IEL,IGEN,INCR,ITPE,IGPE,IGRE,           EXEL  31
     1                          (KNE(IN),IN=1,I10)                      EXEL  32
2010  FORMAT(' >>>>>',16I5)                                             EXEL  33
      IF(IEL) 80,80,20                                                  EXEL  34
C-------  NOMBRE DE NOEUDS  ET LECTURE DE CARTES ADDITIONNELLES         EXEL  35
20    INEL=0                                                            EXEL  36
      I1=1                                                              EXEL  37
      I2=I10                                                            EXEL  38
30    DO 40 IN=I1,I2                                                    EXEL  39
      IF(KNE(IN).EQ.0) GO TO 50                                         EXEL  40
      INEL=INEL+1                                                       EXEL  41
40    CONTINUE                                                          EXEL  42
      I1=I2+1                                                           EXEL  43
      I2=I1+I15                                                         EXEL  44
      READ(M1,1000) (KNE(IN),IN=I1,I2)                                  EXEL  45
      IF(M.GT.0) WRITE(MP,2010) (KNE(IN),IN=I1,I2)                      EXEL  46
      GO TO 30                                                          EXEL  47
C-------  VERIFICATIONS                                                 EXEL  48
50    IF(INEL.GT.NNEL) CALL ERREUR(51,INEL,NNEL,1)                      EXEL  49
      IF(INCR.EQ.0) INCR=1                                              EXEL  50
      IF(ITPE.EQ.0) ITPE=NTPE                                           EXEL  51
      IF(IGPE.GT.NGPE) CALL ERREUR(53,IGPE,NGPE,1)                      EXEL  52
      IF(IGPE.EQ.0) IGPE=1                                              EXEL  53
      IF(IGRE.GT.NGRE) CALL ERREUR(54,IGRE,NGRE,1)                      EXEL  54
C-------  GENERATION DES ELEMENTS                                       EXEL  55
      IF(IGEN.EQ.0) IGEN=1                                              EXEL  56
      DO 70 IE=1,IGEN                                                   EXEL  57
      IF(IEL.GT.NELT) CALL ERREUR(55,IEL,NELT,1)                        EXEL  58
C-------  EXTRACTION DE KLOCE ET MISE A JOUR DE KLD                     EXEL  59
      CALL LOCELD(KDLNC,KNE,KNEQ,KLOCE,KLD)                             EXEL  60
C-------  EXTRACTION DES COORDONNEES ET PROPRIETES DE L'ELEMENT         EXEL  61
      CALL XTRELM(IGPE,VCORG,VPRNG,VPREG,KNE,VCORE,VPRNE,VPREE)         EXEL  62
C-------  VERIFICATION DES NOMBRES DE NOEUDS ET DE D.L. DE L'ELEMENT    EXEL  63
      IPG0=0                                                            EXEL  64
      ICODE=1                                                           EXEL  65
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       EXEL  66
      IF(INEL.EQ.INEL0.AND.IDLE.EQ.IDLE0) GO TO 55                      EXEL  67
      WRITE(MP,2020) IEL,INEL,INEL0,IDLE,IDLE0                          EXEL  68
2020  FORMAT(' ** ELEMENT',I5,' INCOHERENT'/5X,'INEL=',I4,' INEL0=',I5/ EXEL  69
     1  5X,'IDLE=',I5,' IDLE0=',I5)                                     EXEL  70
C-------  METTRE A JOUR LE NOMBRE TOTAL DE POINTS D INTEGRATION         EXEL  71
55    NPG=NPG+IPG0                                                      EXEL  72
C-------  ECRITURE DU FICHIER DES ELEMENTS                              EXEL  73
      CALL WRELEM(M2,KLOCE,VCORE,VPRNE,VPREE,KNE)                       EXEL  74
      IELT=IELT+1                                                       EXEL  75
C-------  IMPRESSION DE L'ELEMENT                                       EXEL  76
      CALL PRELEM(KLOCE,VCORE,VPRNE,VPREE,KNE)                          EXEL  77
C-------  PROCHAIN ELEMENT A GENERER OU LIRE                            EXEL  78
      DO 60 IN=1,INEL                                                   EXEL  79
60    KNE(IN)=KNE(IN)+INCR                                              EXEL  80
      IF(IDLE.GT.NDLE) NDLE=IDLE                                        EXEL  81
70    IEL=IEL+1                                                         EXEL  82
      GO TO 10                                                          EXEL  83
C-------  VERIFICATION DU NOMBRE TOTAL D ELEMENTS                       EXEL  84
80    IF(IELT.NE.NELT) CALL ERREUR(57,IELT,NELT,1)                      EXEL  85
C-------  IMPRESSION DES HAUTEURS DE BANDE                              EXEL  86
      IMA=0                                                             EXEL  87
      IMO=0                                                             EXEL  88
      I1=NEQ+1                                                          EXEL  89
      DO 90 I=2,I1                                                      EXEL  90
      J=KLD(I)                                                          EXEL  91
      IF(J.GT.IMA)IMA=J                                                 EXEL  92
90    IMO=IMO+J                                                         EXEL  93
      C=IMO                                                             EXEL  94
      C=C/NEQ                                                           EXEL  95
      WRITE(MP,2030) C,IMA                                              EXEL  96
2030  FORMAT(/15X,'HAUTEUR DE BANDE MOYENNE=',F8.1,' MAXIMUM=',I5)      EXEL  97
      IF(M.GE.2) WRITE(MP,2040) (KLD(I),I=1,I1)                         EXEL  98
2040  FORMAT(//' TABLE DES HAUTEURS DE BANDE'/(10X,20I5))               EXEL  99
C-------  TRANSFORMER KLD EN POINTEURS VERS LES HAUTS DE COLONNES       EXEL 100
      IF(NSYM.EQ.0) NKE=(NDLE*(NDLE+1))/2                               EXEL 101
      IF(NSYM.EQ.1) NKE=NDLE*NDLE                                       EXEL 102
      KLD(1)=1                                                          EXEL 103
      DO 100 ID=2,I1                                                    EXEL 104
100   KLD(ID)=KLD(ID-1)+KLD(ID)                                         EXEL 105
      NKG=KLD(I1)-1                                                     EXEL 106
      IF(M.GE.2) WRITE(MP,2050) (KLD(ID),ID=1,I1)                       EXEL 107
2050  FORMAT(//' TABLE DES POINTEURS DE HAUTS DE COLONNES  (LD)'/       EXEL 108
     1          (10X,20I6))                                             EXEL 109
      RETURN                                                            EXEL 110
      END                                                               EXEL 111
 
      SUBROUTINE LOCELD(KDLNC,KNE,KNEQ,KLOCE,KLD)                       LOCL   1
C=======================================================================LOCL   2
C     CONSTRUCTION DE LA TABLE DE LOCALISATION ELEMENTAIRE (LOCE)       LOCL   3
C     ET MISE A JOUR DES HAUTEURS DE COLONNES, POUR UN ELEMENT DONNE    LOCL   4
C=======================================================================LOCL   5
      COMMON/COOR/NDIM,NNT                                              LOCL   6
      COMMON/RGDT/NUL(4),IDLE,NUL1(3),INEL                              LOCL   7
      DIMENSION KDLNC(1),KNE(1),KNEQ(1),KLOCE(1),KLD(1)                 LOCL   8
      DATA NDLMAX/32000/                                                LOCL   9
C-----------------------------------------------------------------------LOCL  10
C-------  EXTRAIRE KLOCE DE KNEQ                                        LOCL  11
      IDLE=0                                                            LOCL  12
      LOCMIN=NDLMAX                                                     LOCL  13
      DO 20 IN=1,INEL                                                   LOCL  14
      INN=KNE(IN)                                                       LOCL  15
      IF(INN.GT.NNT) CALL ERREUR(56,INN,NNT,1)                          LOCL  16
      IEQ=KDLNC(INN)                                                    LOCL  17
      IEQ1=KDLNC(INN+1)                                                 LOCL  18
   10 IF(IEQ.GE.IEQ1) GO TO 20                                          LOCL  19
      IEQ=IEQ+1                                                         LOCL  20
      IDLE=IDLE+1                                                       LOCL  21
      J=KNEQ(IEQ)                                                       LOCL  22
      KLOCE(IDLE)=J                                                     LOCL  23
      IF(J.LT.LOCMIN.AND.J.GT.0) LOCMIN=J                               LOCL  24
      GO TO 10                                                          LOCL  25
   20 CONTINUE                                                          LOCL  26
C-------  METTRE A JOUR LA TABLE DES HAUTEURS DE COLONNES (KLD)         LOCL  27
      DO 30 ID=1,IDLE                                                   LOCL  28
      J=KLOCE(ID)                                                       LOCL  29
      IF(J.LE.0) GO TO 30                                               LOCL  30
      IH=J-LOCMIN                                                       LOCL  31
      IF(IH.GT.KLD(J+1))KLD(J+1)=IH                                     LOCL  32
   30 CONTINUE                                                          LOCL  33
      RETURN                                                            LOCL  34
      END                                                               LOCL  35
 
      SUBROUTINE XTRELM(IGPE,VCORG,VPRNG,VPREG,KNE,VCORE,VPRNE,VPREE)   XTRE   1
C=======================================================================XTRE   2
C     EXTRACTION DES COORDONNEES ET PROPRIETES ELEMENTAIRES D'UN        XTRE   3
C     ELEMENT, A PARTIR DES TABLES GLOBALES                             XTRE   4
C     (IGPE: NUMERO DU GROUPE DE PROPRIETE ELEMENTAIRE)                 XTRE   5
C=======================================================================XTRE   6
      IMPLICIT REAL*8(A-H,O-Z)                                          XTRE   7
      COMMON/COOR/NDIM                                                  XTRE   8
      COMMON/PRND/NPRN                                                  XTRE   9
      COMMON/PREL/NGPE,NPRE                                             XTRE  10
      COMMON/RGDT/NUL(5),ICE,IPRNE,IPREE,INEL                           XTRE  11
      DIMENSION VCORG(1),VPRNG(1),VPREG(1),KNE(1),VCORE(1),             XTRE  12
     1  VPRNE(1),VPREE(1)                                               XTRE  13
C-----------------------------------------------------------------------XTRE  14
C-------  EXTRACTION DES COORDONNEES DE L'ELEMENT                       XTRE  15
      IPRNE=0                                                           XTRE  16
      ICE=0                                                             XTRE  17
      DO 30 IN=1,INEL                                                   XTRE  18
      IC=(KNE(IN)-1)*NDIM                                               XTRE  19
      DO 10 I=1,NDIM                                                    XTRE  20
      ICE=ICE+1                                                         XTRE  21
      IC=IC+1                                                           XTRE  22
   10 VCORE(ICE)=VCORG(IC)                                              XTRE  23
C-------  EXTRACTION DES PROPRIETES NODALES DE L'ELEMENT                XTRE  24
      IF(NPRN.EQ.0) GO TO 30                                            XTRE  25
      IC=(KNE(IN)-1)*NPRN                                               XTRE  26
      DO 20 I=1,NPRN                                                    XTRE  27
      IPRNE=IPRNE+1                                                     XTRE  28
      IC=IC+1                                                           XTRE  29
   20 VPRNE(IPRNE)=VPRNG(IC)                                            XTRE  30
   30 CONTINUE                                                          XTRE  31
C-------  EXTRACTION DES PROPRIETES ELEMENTAIRES DE L'ELEMENT           XTRE  32
      IPREE=0                                                           XTRE  33
      IF(NPRE.EQ.0) GO TO 50                                            XTRE  34
      IC=(IGPE-1)*NPRE                                                  XTRE  35
      DO 40 I=1,NPRE                                                    XTRE  36
      IPREE=IPREE+1                                                     XTRE  37
      IC=IC+1                                                           XTRE  38
   40 VPREE(IPREE)=VPREG(IC)                                            XTRE  39
50    RETURN                                                            XTRE  40
      END                                                               XTRE  41
 
      SUBROUTINE PRELEM(KLOCE,VCORE,VPRNE,VPREE,KNE)                    PREL   1
C=======================================================================PREL   2
C     IMPRESSION DES DONNEES DEFINISSANT UN ELEMENT                     PREL   3
C=======================================================================PREL   4
      IMPLICIT REAL*8(A-H,O-Z)                                          PREL   5
      COMMON/PRND/NPRN                                                  PREL   6
      COMMON/PREL/NGPE,NPRE                                             PREL   7
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL         PREL   8
      COMMON/ES/M,MR,MP                                                 PREL   9
      DIMENSION KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),KNE(1)              PREL  10
C-----------------------------------------------------------------------PREL  11
      IF(M.GE.0) WRITE(MP,2000) IEL,ITPE,INEL,IDLE,IPRNE,IPREE,IGRE     PREL  12
2000  FORMAT(10X,'ELEMENT:',I5,' TYPE:',I2,' P.N.:',I2,' D.L.:',        PREL  13
     1  I3,' PROP N.:',I3,' PROP EL.:',I3,' GROUPE:',I3)                PREL  14
      IF(M.GE.0) WRITE(MP,2010) (KNE(I),I=1,INEL)                       PREL  15
2010  FORMAT(15X,'CONNECTIVITE (NE)',20I5/(32X,20I5))                   PREL  16
      IF(M.LT.1) GO TO 10                                               PREL  17
      WRITE(MP,2020) (KLOCE(I),I=1,IDLE)                                PREL  18
2020  FORMAT(15X,'LOCALISATN (LOCE)',20I5/(32X,20I5))                   PREL  19
      WRITE(MP,2030) (VCORE(I),I=1,ICE)                                 PREL  20
2030  FORMAT(15X,'COORDONNEES(CORE)',8E12.5/(32X,8E12.5))               PREL  21
      IF(NPRN.GT.0) WRITE(MP,2040) (VPRNE(I),I=1,IPRNE)                 PREL  22
2040  FORMAT(15X,'PROP.NOD.  (PRNE)',8E12.5/(32X,8E12.5))               PREL  23
      IF(IPREE.GT.0) WRITE(MP,2050) (VPREE(I),I=1,IPREE)                PREL  24
2050  FORMAT(15X,'PROP. ELEM.(PREE)',8E12.5/(32X,8E12.5))               PREL  25
10    RETURN                                                            PREL  26
      END                                                               PREL  27
 
      SUBROUTINE WRELEM(ME,KLOCE,VCORE,VPRNE,VPREE,KNE)                 WREL   1
C=======================================================================WREL   2
C     ECRITURE DES DONNEES ELEMENTAIRES SUR LE FICHIER ME               WREL   3
C=======================================================================WREL   4
      IMPLICIT REAL*8(A-H,O-Z)                                          WREL   5
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL         WREL   6
      DIMENSION KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),KNE(1)              WREL   7
C-----------------------------------------------------------------------WREL   8
      IPRNE1=IPRNE                                                      WREL   9
      IF(IPRNE1.EQ.0) IPRNE1=1                                          WREL  10
      IPREE1=IPREE                                                      WREL  11
      IF(IPREE1.EQ.0) IPREE1=1                                          WREL  12
      WRITE(ME)IEL,ITPE,IGRE,IDLE,ICE,IPRNE1,IPREE1,INEL,               WREL  13
     1          (KLOCE(I),I=1,IDLE),(VCORE(I),I=1,ICE),                 WREL  14
     2          (VPRNE(I),I=1,IPRNE1),(VPREE(I),I=1,IPREE1),            WREL  15
     3          (KNE(I),I=1,INEL)                                       WREL  16
      RETURN                                                            WREL  17
      END                                                               WREL  18
 
      SUBROUTINE RDELEM(ME,KLOCE,VCORE,VPRNE,VPREE,KNE)                 RDEL   1
C=======================================================================RDEL   2
C     LECTURE DES DONNEES ELEMENTAIRES SUR LE FICHIER ME                RDEL   3
C=======================================================================RDEL   4
      IMPLICIT REAL*8(A-H,O-Z)                                          RDEL   5
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL         RDEL   6
      DIMENSION KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),KNE(1)              RDEL   7
C-----------------------------------------------------------------------RDEL   8
      READ(ME) IEL,ITPE,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,                 RDEL   9
     1          (KLOCE(I),I=1,IDLE),(VCORE(I),I=1,ICE),                 RDEL  10
     2          (VPRNE(I),I=1,IPRNE),(VPREE(I),I=1,IPREE),              RDEL  11
     3          (KNE(I),I=1,INEL)                                       RDEL  12
      RETURN                                                            RDEL  13
      END                                                               RDEL  14
C++++++  FIN FIGURE 6.18
C++++++  DEBUT FIGURE 6.19
      SUBROUTINE BLSOLC                                                 BLSC   1
C=======================================================================BLSC   2
C     APPEL DU BLOC 'SOLC'                                              BLSC   3
C     LECTURE DES SOLLICITATIONS CONCENTREES                            BLSC   4
C=======================================================================BLSC   5
      IMPLICIT REAL*8(A-H,O-Z)                                          BLSC   6
      REAL*4 TBL                                                        BLSC   7
      COMMON/RESO/NEQ                                                   BLSC   8
      COMMON/ES/M,MR,MP,M1                                              BLSC   9
      COMMON/LOC/LCORG,LDLNC,LNEQ,LXX(15),LFG                           BLSC  10
      COMMON VA(1)                                                      BLSC  11
      DATA TBL/4HFG  /                                                  BLSC  12
C-----------------------------------------------------------------------BLSC  13
      IF(M1.EQ.0) M1=MR                                                 BLSC  14
      WRITE(MP,2000) M                                                  BLSC  15
2000  FORMAT(//' LECTURE DES SOLLICITATIONS CONCENTREES (M=',I2,')'/' ',BLSC  16
     1  39('='))                                                        BLSC  17
      IF(LFG.EQ.1) CALL ESPACE(NEQ,1,TBL,LFG)                           BLSC  18
      CALL EXSOLC(VA(LFG),VA(LDLNC),VA(LNEQ))                           BLSC  19
      RETURN                                                            BLSC  20
      END                                                               BLSC  21
 
      SUBROUTINE EXSOLC(VFG,KDLNC,KNEQ)                                 EXSC   1
C=======================================================================EXSC   2
C     EXECUTION DU BLOC 'SOLC'                                          EXSC   3
C     LECTURE DES SOLLICITATIONS CONCENTREES                            EXSC   4
C====================================================================== EXSC   5
      IMPLICIT REAL*8 (A-H,O-Z)                                         EXSC   6
      COMMON/COOR/NDIM,NNT,NDLN                                         EXSC   7
      COMMON/RESO/NEQ                                                   EXSC   8
      COMMON/ES/M,MR,MP,M1                                              EXSC   9
      COMMON/TRVL/KV(16),V(14)                                          EXSC  10
      DIMENSION VFG(1),KDLNC(1),KNEQ(1)                                 EXSC  11
      DATA L16/16/                                                      EXSC  12
C-----------------------------------------------------------------------EXSC  13
C-------  LECTURE DES DONNEES                                           EXSC  14
      IF(M.GE.0)WRITE(MP,2000)                                          EXSC  15
2000  FORMAT(//' CARTES DE SOLLICITATIONS NODALES'//)                   EXSC  16
      I0=MIN0(7,NDLN)                                                   EXSC  17
10    READ(M1,1000) IG,(V(I),I=1,I0)                                    EXSC  18
1000  FORMAT(I5,7F10.0)                                                 EXSC  19
      IF(NDLN.GT.7) READ(M1,1005) (V(I),I=8,NDLN)                       EXSC  20
1005  FORMAT(5X,7F10.0)                                                 EXSC  21
      IF(M.GE.0)WRITE(MP,2010)IG,(V(I),I=1,NDLN)                        EXSC  22
2010  FORMAT(' >>>>>',I5,7E12.5/(' >>>>>',5X,7E12.5))                   EXSC  23
      IF(IG.LE.0) GO TO 60                                              EXSC  24
20    READ(M1,1010)(KV(I),I=1,L16)                                      EXSC  25
1010  FORMAT(16I5)                                                      EXSC  26
      IF(M.GE.0)WRITE(MP,2020)(KV(I),I=1,L16)                           EXSC  27
2020  FORMAT(' >>>>>',16I5)                                             EXSC  28
C----- EXPLORATION DES NOEUDS                                           EXSC  29
      DO 50 IN=1,L16                                                    EXSC  30
      I1=KV(IN)                                                         EXSC  31
      IF(I1.GT.NNT) CALL ERREUR(61,I1,NNT,1)                            EXSC  32
      IF(I1)10,10,30                                                    EXSC  33
30    ID1=KDLNC(I1)+1                                                   EXSC  34
      ID2=KDLNC(I1+1)                                                   EXSC  35
      J=0                                                               EXSC  36
      DO 50 ID=ID1,ID2                                                  EXSC  37
      J=J+1                                                             EXSC  38
      IEQ=KNEQ(ID)                                                      EXSC  39
      IF(IEQ)50,50,40                                                   EXSC  40
40    VFG(IEQ)=VFG(IEQ)+V(J)                                            EXSC  41
50    CONTINUE                                                          EXSC  42
      GO TO 20                                                          EXSC  43
C----- IMPRESSION                                                       EXSC  44
60    IF(M.GE.1)WRITE(MP,2030)(VFG(I),I=1,NEQ)                          EXSC  45
2030  FORMAT(//' VECTEUR SOLLICITATION TOTAL'/(10X,10E12.5))            EXSC  46
      RETURN                                                            EXSC  47
      END                                                               EXSC  48
C++++++  FIN FIGURE 6.19
C++++++  DEBUT FIGURE 6.21
      SUBROUTINE BLSOLR                                                 BLSR   1
C=======================================================================BLSR   2
C     APPEL DU BLOC 'SOLR'                                              BLSR   3
C     ASSEMBLAGE DES SOLLICITATIONS REPARTIES (FONCTION ELEMENTAIRE 7)  BLSR   4
C=======================================================================BLSR   5
      IMPLICIT REAL*8(A-H,O-Z)                                          BLSR   6
      REAL*4 TBL                                                        BLSR   7
      COMMON/COOR/NDIM,NNT,NDLN,NDLT                                    BLSR   8
      COMMON/ELEM/NUL(4),ME                                             BLSR   9
      COMMON/ASSE/NSYM,NKG,NKE,NDLE                                     BLSR  10
      COMMON/RESO/NEQ,NRES,MRES                                         BLSR  11
      COMMON/ES/M,MR,MP,M1,M2                                           BLSR  12
      COMMON/LOC/LCORG,LDLNC,LNEQ,LDIMP,LPRNG,LPREG,LLD,LLOCE,LCORE,LNE,BLSR  13
     1  LPRNE,LPREE,LDLE,LKE,LFE,LKGS,LKGD,LKGI,LFG,LRES,LDLG           BLSR  14
      COMMON VA(1)                                                      BLSR  15
      DIMENSION TBL(8)                                                  BLSR  16
      DATA TBL/4HFG  ,4HKE  ,4HFE  ,4HDLE ,4HKGS ,4HKGD ,4HKGI ,        BLSR  17
     1  4HRES /                                                         BLSR  18
C-----------------------------------------------------------------------BLSR  19
      IF(M1.EQ.0) M1=MR                                                 BLSR  20
      IF(M2.EQ.0) M2=ME                                                 BLSR  21
      WRITE(MP,2000) M                                                  BLSR  22
2000  FORMAT(//' ASSEMBLAGE DES SOLLICITATIONS REPARTIES (M=',I2,')'/   BLSR  23
     1  1X,40('=')/)                                                    BLSR  24
      IF(LFG.EQ.1) CALL ESPACE(NEQ,1,TBL(1),LFG)                        BLSR  25
      IF(LKE.EQ.1) CALL ESPACE(NKE,1,TBL(2),LKE)                        BLSR  26
      IF(LFE.EQ.1) CALL ESPACE(NDLE,1,TBL(3),LFE)                       BLSR  27
      IF(LDLE.EQ.1) CALL ESPACE(NDLE,1,TBL(4),LDLE)                     BLSR  28
      IF(LKGS.EQ.1) CALL ESPACE(NKG,1,TBL(5),LKGS)                      BLSR  29
      IF(LKGD.EQ.1) CALL ESPACE(NEQ,1,TBL(6),LKGD)                      BLSR  30
      IF(NSYM.EQ.1.AND.LKGI.EQ.1) CALL ESPACE(NKG,1,TBL(7),LKGI)        BLSR  31
      IF(LRES.EQ.1) CALL ESPACE(NDLT,1,TBL(8),LRES)                     BLSR  32
      CALL EXSOLR(VA(LLD),VA(LDIMP),VA(LLOCE),VA(LCORE),VA(LPRNE),      BLSR  33
     1            VA(LPREE),VA(LNE),VA(LKE),VA(LFE),VA(LKGS),VA(LKGD),  BLSR  34
     2            VA(LKGI),VA(LFG),VA(LCORG),VA(LDLNC),VA(LNEQ),        BLSR  35
     3            VA(LRES),VA(LDLE))                                    BLSR  36
      RETURN                                                            BLSR  37
      END                                                               BLSR  38
 
      SUBROUTINE EXSOLR(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,  EXSR   1
     1       VKGS,VKGD,VKGI,VFG,VCORG,KDLNC,KNEQ,VRES,VDLE)             EXSR   2
C=======================================================================EXSR   3
C     EXECUTION DU BLOC 'SOLR'                                          EXSR   4
C     ASSEMBLAGE DES SOLLICITATIONS REPARTIES (FONCTION ELEMENTAIRE 7)  EXSR   5
C=======================================================================EXSR   6
      IMPLICIT REAL*8(A-H,O-Z)                                          EXSR   7
      COMMON/ASSE/NSYM,NKG,NKE,NDLE                                     EXSR   8
      COMMON/RESO/NEQ,NRES                                              EXSR   9
      COMMON/ES/M,MR,MP,M1,M2                                           EXSR  10
      DIMENSION KLD(1),VDIMP(1),KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),    EXSR  11
     1  KNE(1),VKE(1),VFE(1),VKGS(1),VKGD(1),VKGI(1),VFG(1),VCORG(1),   EXSR  12
     2  KDLNC(1),KNEQ(1),VRES(1),VDLE(1)                                EXSR  13
C-----------------------------------------------------------------------EXSR  14
C-----  ASSEMBLER FG                                                    EXSR  15
      CALL ASFG(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,VKGS,     EXSR  16
     1  VKGD,VKGI,VFG,VDLE,VRES)                                        EXSR  17
C-------  IMPRESSION                                                    EXSR  18
      IF(M.GE.1) WRITE(MP,2000) (VFG(I),I=1,NEQ)                        EXSR  19
2000  FORMAT(/' VECTEUR SOLLICITATIONS GLOBAL  (FG)'/(1X,10E12.5))      EXSR  20
      RETURN                                                            EXSR  21
      END                                                               EXSR  22
 
      SUBROUTINE ASFG(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,    ASFG   1
     1  VKGS,VKGD,VKGI,VFG,VDLE,VRES)                                   ASFG   2
C=======================================================================ASFG   3
C     ASSEMBLAGE DE FG DUE AUX SOLLICITATIONS REPARTIES (FONCTION 7)    ASFG   4
C=======================================================================ASFG   5
      IMPLICIT REAL*8(A-H,O-Z)                                          ASFG   6
      COMMON/ELEM/NELT,NNEL,NTPE,NGRE,ME,NIDENT                         ASFG   7
      COMMON/ASSE/NSYM                                                  ASFG   8
      COMMON/RESO/NEQ                                                   ASFG   9
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGASFG  10
     1  ,ICOD                                                           ASFG  11
      COMMON/ES/M,MR,MP,M1,M2                                           ASFG  12
      DIMENSION KLD(1),VDIMP(1),KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),    ASFG  13
     1  KNE(1),VKE(1),VFE(1),VKGS(1),VKGD(1),VKGI(1),VFG(1),VDLE(1),    ASFG  14
     2  VRES(1)                                                         ASFG  15
C-----------------------------------------------------------------------ASFG  16
C-------  POSITIONNER AU DEBUT LE FICHIER DES ELEMENTS (M2)             ASFG  17
      REWIND M2                                                         ASFG  18
C-------  BOUCLE SUR LES ELEMENTS                                       ASFG  19
      DO 20 IE=1,NELT                                                   ASFG  20
C-------  LIRE UN ELEMENT SUR LE FICHIER M2                             ASFG  21
      CALL RDELEM(M2,KLOCE,VCORE,VPRNE,VPREE,KNE)                       ASFG  22
C-------  CALCUL DES FONCTIONS D'INTERPOLATION SI NECESSAIRE            ASFG  23
      IF(ITPE.EQ.ITPE1) GO TO 10                                        ASFG  24
      ICOD=2                                                            ASFG  25
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASFG  26
C-------  CALCUL DU VECTEUR ELEMENTAIRE                                 ASFG  27
10    ICOD=7                                                            ASFG  28
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASFG  29
C-------  IMPRESSION DU VECTEUR ELEMENTAIRE VFE                         ASFG  30
      IF(M.GE.2) WRITE(MP,2000) IEL,(VFE(I),I=1,IDLE)                   ASFG  31
2000  FORMAT(/' VECTEUR (FE) , ELEMENT:',I5/(10X,10E12.5))              ASFG  32
C-------  ASSEMBLAGE                                                    ASFG  33
      CALL ASSEL(0,1,IDLE,NSYM,KLOCE,KLD,VKE,VFE,VKGS,VKGD,VKGI,VFG)    ASFG  34
20    ITPE1=ITPE                                                        ASFG  35
      RETURN                                                            ASFG  36
      END                                                               ASFG  37
C++++++  FIN FIGURE 6.21
C++++++  DEBUT FIGURE 6.22
      SUBROUTINE BLLINM                                                 BLLM   1
C=======================================================================BLLM   2
C     APPEL DU BLOC 'LINM'                                              BLLM   3
C     ASSEMBLAGE ET RESOLUTION D'UN PROBLEME LINEAIRE EN MEMOIRE        BLLM   4
C=======================================================================BLLM   5
      IMPLICIT REAL*8(A-H,O-Z)                                          BLLM   6
      REAL*4 TBL                                                        BLLM   7
      COMMON/COOR/NDIM,NNT,NDLN,NDLT                                    BLLM   8
      COMMON/ELEM/NUL(4),ME                                             BLLM   9
      COMMON/ASSE/NSYM,NKG,NKE,NDLE                                     BLLM  10
      COMMON/RESO/NEQ,NRES,MRES                                         BLLM  11
      COMMON/ES/M,MR,MP,M1,M2,M3                                        BLLM  12
      COMMON/LOC/LCORG,LDLNC,LNEQ,LDIMP,LPRNG,LPREG,LLD,LLOCE,LCORE,LNE,BLLM  13
     1  LPRNE,LPREE,LDLE,LKE,LFE,LKGS,LKGD,LKGI,LFG,LRES,LDLG           BLLM  14
      COMMON VA(1)                                                      BLLM  15
      DIMENSION TBL(8)                                                  BLLM  16
      DATA TBL/4HKGS ,4HKGD ,4HKGI ,4HFG  ,4HKE  ,4HFE  ,4HRES ,4HDLE / BLLM  17
C-----------------------------------------------------------------------BLLM  18
      IF(M1.EQ.0) M1=MR                                                 BLLM  19
      IF(M2.EQ.0) M2=ME                                                 BLLM  20
      IF(M3.EQ.0) M3=MRES                                               BLLM  21
      READ(M1,1000) IN                                                  BLLM  22
1000  FORMAT(1I5)                                                       BLLM  23
      IF(IN.NE.0) NRES=1                                                BLLM  24
      WRITE(MP,2000) M,NRES                                             BLLM  25
2000  FORMAT(//' ASSEMBLAGE-RESOLUTION LINEAIRE (M=',I2,')'/' ',30('=')/BLLM  26
     1  15X,' INDICE DE CALCUL DU RESIDU        (NRES)=',I5)            BLLM  27
      IF(LKGS.EQ.1) CALL ESPACE(NKG,1,TBL(1),LKGS)                      BLLM  28
      IF(LKGD.EQ.1) CALL ESPACE(NEQ,1,TBL(2),LKGD)                      BLLM  29
      IF(NSYM.EQ.1.AND.LKGI.EQ.1) CALL ESPACE(NKG,1,TBL(3),LKGI)        BLLM  30
      IF(LFG.EQ.1) CALL ESPACE(NEQ,1,TBL(4),LFG)                        BLLM  31
      IF(LKE.EQ.1) CALL ESPACE(NKE,1,TBL(5),LKE)                        BLLM  32
      IF(LFE.EQ.1) CALL ESPACE(NDLE,1,TBL(6),LFE)                       BLLM  33
      IF(LRES.EQ.1) CALL ESPACE(NDLT,1,TBL(7),LRES)                     BLLM  34
      IF(LDLE.EQ.1) CALL ESPACE(NDLE,1,TBL(8),LDLE)                     BLLM  35
      CALL EXLINM(VA(LLD),VA(LDIMP),VA(LLOCE),VA(LCORE),VA(LPRNE),      BLLM  36
     1            VA(LPREE),VA(LNE),VA(LKE),VA(LFE),VA(LKGS),VA(LKGD),  BLLM  37
     2            VA(LKGI),VA(LFG),VA(LCORG),VA(LDLNC),VA(LNEQ),        BLLM  38
     3            VA(LRES),VA(LDLE))                                    BLLM  39
      RETURN                                                            BLLM  40
      END                                                               BLLM  41
 
      SUBROUTINE EXLINM(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,  EXLM   1
     1       VKGS,VKGD,VKGI,VFG,VCORG,KDLNC,KNEQ,VRES,VDLE)             EXLM   2
C=======================================================================EXLM   3
C     EXECUTION DU BLOC 'LINM'                                          EXLM   4
C     ASSEMBLAGE ET RESOLUTION D'UN PROBLEME LINEAIRE EN MEMOIRE        EXLM   5
C=======================================================================EXLM   6
      IMPLICIT REAL*8(A-H,O-Z)                                          EXLM   7
      COMMON/ASSE/NSYM,NKG,NKE,NDLE                                     EXLM   8
      COMMON/RESO/NEQ,NRES,MRES                                         EXLM   9
      COMMON/ES/M,MR,MP,M1,M2,M3                                        EXLM  10
      DIMENSION KLD(1),VDIMP(1),KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),    EXLM  11
     1  KNE(1),VKE(1),VFE(1),VKGS(1),VKGD(1),VKGI(1),VFG(1),VCORG(1),   EXLM  12
     2  KDLNC(1),KNEQ(1),VRES(1),VDLE(1)                                EXLM  13
C-----------------------------------------------------------------------EXLM  14
      REWIND M3                                                         EXLM  15
C                                                                       EXLM  16
C-------  ASSEMBLER KG                                                  EXLM  17
C                                                                       EXLM  18
C-------  SAUVER SUR M3 LE VECTEUR FG NON MODIFIE PAR LES C.L.          EXLM  19
      WRITE(M3) (VFG(I),I=1,NEQ)                                        EXLM  20
      IF(M.GE.2) WRITE(MP,2000) (VFG(I),I=1,NEQ)                        EXLM  21
2000  FORMAT(/' VECTEUR SOLLICITATIONS GLOBAL NON MODIFIE PAR LES C.L. (EXLM  22
     1FG)'/(1X,10E12.5))                                                EXLM  23
C-------  ASSEMBLER KG,MODIFIER FG POUR LES C.L. ET LES SAUVER          EXLM  24
      CALL ASKG(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,VKGS,     EXLM  25
     1  VKGD,VKGI,VFG,VDLE,VRES)                                        EXLM  26
      WRITE(M3) (VFG(I),I=1,NEQ)                                        EXLM  27
      WRITE(M3) (VKGS(I),I=1,NKG),(VKGD(I),I=1,NEQ)                     EXLM  28
      IF(NSYM.EQ.1) WRITE(M3) (VKGI(I),I=1,NKG)                         EXLM  29
C-------  IMPRESSION DE KG ET FG                                        EXLM  30
      IF(M.LT.2) GO TO 20                                               EXLM  31
      WRITE(MP,2005) (VKGS(I),I=1,NKG)                                  EXLM  32
2005  FORMAT(/' MATRICE GLOBALE (KG)'/'    TRIANGLE SUPERIEUR'/         EXLM  33
     1  (1X,10E12.5))                                                   EXLM  34
      WRITE(MP,2010) (VKGD(I),I=1,NEQ)                                  EXLM  35
2010  FORMAT('    DIAGONALE'/(1X,10E12.5))                              EXLM  36
      IF(NSYM.EQ.1) WRITE(MP,2020) (VKGI(I),I=1,NKG)                    EXLM  37
2020  FORMAT('    TRIANGLE INFERIEUR'/(1X,10E12.5))                     EXLM  38
      WRITE(MP,2030) (VFG(I),I=1,NEQ)                                   EXLM  39
2030  FORMAT(/' VECTEUR SOLLICITATIONS GLOBAL MODIFIE PAR LES C.L. (FG)'EXLM  40
     1 /(1X,10E12.5))                                                   EXLM  41
C                                                                       EXLM  42
C-------  RESOLUTION                                                    EXLM  43
C                                                                       EXLM  44
20    CALL SOL(VKGS,VKGD,VKGI,VFG,KLD,NEQ,MP,1,1,NSYM,ENERG)            EXLM  45
      IF(NSYM.NE.1) WRITE(MP,2035) ENERG                                EXLM  46
2035  FORMAT(15X,'ENERGIE    (ENERG)=',1E12.5)                          EXLM  47
      IF(M.LT.2) GO TO 30                                               EXLM  48
      WRITE(MP,2040) (VKGS(I),I=1,NKG)                                  EXLM  49
2040  FORMAT(/' MATRICE TRIANGULARISEE (KG)'/'    TRIANGLE SUPERIEUR'/  EXLM  50
     1  (1X,10E12.5))                                                   EXLM  51
      WRITE(MP,2010) (VKGD(I),I=1,NEQ)                                  EXLM  52
      IF(NSYM.EQ.1) WRITE(MP,2020) (VKGI(I),I=1,NKG)                    EXLM  53
C-------  PIVOTS DE KG ET DETERMINANT                                   EXLM  54
30    CALL PRPVTS(VKGD)                                                 EXLM  55
C-------  CALCUL ET IMPRESSION DES RESIDUS DE RESOLUTION  K.U - F       EXLM  56
      IF(NRES.EQ.1) CALL PRRESD(VKGS,VKGD,VKGI,VFG,KLD,VRES)            EXLM  57
C-------  IMPRESSION DE LA SOLUTION                                     EXLM  58
      WRITE(MP,2050)                                                    EXLM  59
2050  FORMAT(//' SOLUTION'//)                                           EXLM  60
      CALL PRSOL(KDLNC,VCORG,VDIMP,KNEQ,VFG)                            EXLM  61
C                                                                       EXLM  62
C-------  CALCUL ET IMPRESSION DES GRADIENTS (CONTRAINTES)              EXLM  63
C                                                                       EXLM  64
      CALL ASGRAD(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,VKGS,   EXLM  65
     1  VKGD,VKGI,VFG,VDLE,VRES)                                        EXLM  66
C                                                                       EXLM  67
C-------  CALCUL ET IMPRESSION DES RESIDUS D'EQUILIBRE                  EXLM  68
C                                                                       EXLM  69
C-------  LIRE LE VECTEUR FG ET LE CHANGER DE SIGNE                     EXLM  70
      REWIND M3                                                         EXLM  71
      READ(M3) (VRES(I),I=1,NEQ)                                        EXLM  72
      DO 40 I=1,NEQ                                                     EXLM  73
40    VRES(I)=-VRES(I)                                                  EXLM  74
C-------  ASSEMBLER LES RESIDUS                                         EXLM  75
      CALL ASRESD(1,1,KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,    EXLM  76
     1  VKGS,VKGD,VKGI,VFG,VDLE,VRES,VRES(NEQ+1))                       EXLM  77
C-------  IMPRESSION DES RESIDUS                                        EXLM  78
      WRITE(MP,2060)                                                    EXLM  79
2060  FORMAT(//' RESIDUS D EQUILIBRE ET REACTIONS'//)                   EXLM  80
      CALL PRSOL(KDLNC,VCORG,VRES(NEQ+1),KNEQ,VRES)                     EXLM  81
      RETURN                                                            EXLM  82
      END                                                               EXLM  83
 
      SUBROUTINE ASKG(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,    ASKG   1
     1  VKGS,VKGD,VKGI,VFG,VDLE,VRES)                                   ASKG   2
C=======================================================================ASKG   3
C     ASSEMBLAGE DE LA MATRICE GLOBALE KG (FONCTION ELEMENTAIRE 3)      ASKG   4
C       AVEC PRISE EN COMPTE DES D.L. IMPOSES NON NULS                  ASKG   5
C=======================================================================ASKG   6
      IMPLICIT REAL*8(A-H,O-Z)                                          ASKG   7
      COMMON/COND/NCLT,NCLZ,NCLNZ                                       ASKG   8
      COMMON/ELEM/NELT,NNEL,NTPE,NGRE,ME,NIDENT                         ASKG   9
      COMMON/ASSE/NSYM                                                  ASKG  10
      COMMON/RESO/NEQ                                                   ASKG  11
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGASKG  12
     1  ,ICOD                                                           ASKG  13
      COMMON/ES/M,MR,MP,M1,M2                                           ASKG  14
      DIMENSION KLD(1),VDIMP(1),KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),    ASKG  15
     1  KNE(1),VKE(1),VFE(1),VKGS(1),VKGD(1),VKGI(1),VFG(1),VDLE(1),    ASKG  16
     2  VRES(1),KEB(1)                                                  ASKG  17
C-----------------------------------------------------------------------ASKG  18
C-------  POSITIONNER AU DEBUT LE FICHIER DES ELEMENTS (M2)             ASKG  19
      REWIND M2                                                         ASKG  20
C-------  BOUCLE SUR LES ELEMENTS                                       ASKG  21
      DO 30 IE=1,NELT                                                   ASKG  22
C-------  LIRE UN ELEMENT                                               ASKG  23
      CALL RDELEM(M2,KLOCE,VCORE,VPRNE,VPREE,KNE)                       ASKG  24
C-------  NE PAS RECALCULER LES ELEMENTS IDENTIQUES                     ASKG  25
      IF(NIDENT.EQ.1.AND.IE.GT.1) GO TO 20                              ASKG  26
C-------  CALCUL DES FONCTIONS D'INTERPOLATION SI NECESSAIRE            ASKG  27
      IF(ITPE.EQ.ITPE1) GO TO 10                                        ASKG  28
      ICOD=2                                                            ASKG  29
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASKG  30
C-------  CALCUL DE LA MATRICE ELEMENTAIRE                              ASKG  31
10    ICOD=3                                                            ASKG  32
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASKG  33
C-------  IMPRESSION DE LA MATRICE ELEMENTAIRE                          ASKG  34
      IF(M.LT.2) GO TO 20                                               ASKG  35
      IF(NSYM.EQ.0) IKE=IDLE*(IDLE+1)/2                                 ASKG  36
      IF(NSYM.EQ.1) IKE=IDLE*IDLE                                       ASKG  37
      WRITE(MP,2000) IEL,(VKE(I),I=1,IKE)                               ASKG  38
2000  FORMAT(/' MATRICE (KE) , ELEMENT:',I5/(10X,10E12.5))              ASKG  39
C-------  MODIFICATION DE FG DUE AUX D.L. IMPOSES NON NULS              ASKG  40
20    IF(NCLNZ.NE.0) CALL MODFG(IDLE,NSYM,KLOCE,VDIMP,VKE,VFG)          ASKG  41
C-------  ASSEMBLAGE                                                    ASKG  42
      CALL ASSEL(1,0,IDLE,NSYM,KLOCE,KLD,VKE,VFE,VKGS,VKGD,VKGI,VFG)    ASKG  43
30    ITPE1=ITPE                                                        ASKG  44
      RETURN                                                            ASKG  45
      END                                                               ASKG  46
 
      SUBROUTINE ASGRAD(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,  ASGR   1
     1  VKGS,VKGD,VKGI,VFG,VDLE,VRES)                                   ASGR   2
C=======================================================================ASGR   3
C     CALCUL ET IMPRESSION DES GRADIENTS (CONTRAINTES) AUX P.G. DES     ASGR   4
C       ELEMENTS (FONCTION ELEMENTAIRE 8)                               ASGR   5
C=======================================================================ASGR   6
      IMPLICIT REAL*8(A-H,O-Z)                                          ASGR   7
      COMMON/ELEM/NELT,NNEL,NTPE,NGRE,ME,NIDENT                         ASGR   8
      COMMON/ASSE/NSYM                                                  ASGR   9
      COMMON/RESO/NEQ                                                   ASGR  10
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGASGR  11
     1  ,ICOD                                                           ASGR  12
      COMMON/ES/M,MR,MP,M1,M2                                           ASGR  13
      DIMENSION KLD(1),VDIMP(1),KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),    ASGR  14
     1  KNE(1),VKE(1),VFE(1),VKGS(1),VKGD(1),VKGI(1),VFG(1),VDLE(1),    ASGR  15
     2  VRES(1)                                                         ASGR  16
C-----------------------------------------------------------------------ASGR  17
C-------  POSITIONNER AU DEBUT LE FICHIER DES ELEMENTS (M2)             ASGR  18
      REWIND M2                                                         ASGR  19
C-------  BOUCLE SUR LES ELEMENTS                                       ASGR  20
      DO 20 IE=1,NELT                                                   ASGR  21
C-------  LIRE UN ELEMENT                                               ASGR  22
      CALL RDELEM(M2,KLOCE,VCORE,VPRNE,VPREE,KNE)                       ASGR  23
C-------  CALCUL DES FONCTIONS D'INTERPOLATION SI NECESSAIRE            ASGR  24
      IF(ITPE.EQ.ITPE1) GO TO 10                                        ASGR  25
      ICOD=2                                                            ASGR  26
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASGR  27
C-------  EXTRAIRE LES D.L. DE L'ELEMENT                                ASGR  28
10    CALL DLELM(KLOCE,VFG,VDIMP,VDLE)                                  ASGR  29
C-------  CALCUL ET IMPRESSION DES CONTRAINTES OU GRADIENTS             ASGR  30
      ICOD=8                                                            ASGR  31
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASGR  32
20    ITPE1=ITPE                                                        ASGR  33
      RETURN                                                            ASGR  34
      END                                                               ASGR  35
 
      SUBROUTINE ASRESD(IRESD,IREAC,KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,  ASRE   1
     1  KNE,VKE,VFE,VKGS,VKGD,VKGI,VFG,VDLE,VRES,VREAC)                 ASRE   2
C=======================================================================ASRE   3
C     ASSEMBLAGE DES RESIDUS INTERNES DANS VRES (SI IRESD.EQ.1)         ASRE   4
C     ET DES REACTIONS EXTERNES DANS VREAC (SI IREAC.EQ.1)              ASRE   5
C=======================================================================ASRE   6
      IMPLICIT REAL*8(A-H,O-Z)                                          ASRE   7
      COMMON/ELEM/NELT,NNEL,NTPE,NGRE,ME,NIDENT                         ASRE   8
      COMMON/ASSE/NSYM                                                  ASRE   9
      COMMON/RESO/NEQ                                                   ASRE  10
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGASRE  11
     1  ,ICOD                                                           ASRE  12
      COMMON/ES/M,MR,MP,M1,M2                                           ASRE  13
      DIMENSION KLD(1),VDIMP(1),KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),    ASRE  14
     1  KNE(1),VKE(1),VFE(1),VKGS(1),VKGD(1),VKGI(1),VFG(1),VDLE(1),    ASRE  15
     2  VRES(1),VREAC(1)                                                ASRE  16
C-----------------------------------------------------------------------ASRE  17
C-------  POSITIONNER AU DEBUT LE FICHIER DES ELEMENTS (M2)             ASRE  18
      REWIND M2                                                         ASRE  19
C-------  BOUCLE SUR LES ELEMENTS                                       ASRE  20
      DO 60 IE=1,NELT                                                   ASRE  21
C-------  LIRE UN ELEMENT                                               ASRE  22
      CALL RDELEM(M2,KLOCE,VCORE,VPRNE,VPREE,KNE)                       ASRE  23
C-------  CALCUL DES FONCTIONS D'INTERPOLATION SI NECESSAIRE            ASRE  24
      IF(ITPE.EQ.ITPE1) GO TO 10                                        ASRE  25
      ICOD=2                                                            ASRE  26
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASRE  27
C-------  EXTRAIRE LES D.L. DE L'ELEMENT                                ASRE  28
10    CALL DLELM(KLOCE,VFG,VDIMP,VDLE)                                  ASRE  29
C-------  CALCUL DES REACTIONS ELEMENTAIRES                             ASRE  30
      ICOD=6                                                            ASRE  31
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASRE  32
C-------  IMPRESSION DES REACTIONS ELEMENTAIRES                         ASRE  33
      IF(M.GE.2) WRITE(MP,2000) IEL,(VFE(I),I=1,IDLE)                   ASRE  34
2000  FORMAT(/' REACTIONS (FE) , ELEMENT:',I5/(10X,10E12.5))            ASRE  35
      IF(IRESD.NE.1) GO TO 20                                           ASRE  36
C-------  ASSEMBLAGE DES RESIDUS INTERNES                               ASRE  37
      CALL ASSEL(0,1,IDLE,NSYM,KLOCE,KLD,VKE,VFE,VKGS,VKGD,VKGI,VRES)   ASRE  38
20    IF(IREAC.NE.1) GO TO 60                                           ASRE  39
C-------  ASSEMBLAGE DES REACTIONS EXTERNES                             ASRE  40
C       MODIFIER LES TERMES DE KLOCE POUR ASSEMBLER SEULEMENT LES D.L.  ASRE  41
C       IMPOSES                                                         ASRE  42
      DO 50 ID=1,IDLE                                                   ASRE  43
      IF(KLOCE(ID)) 30,50,40                                            ASRE  44
30    KLOCE(ID)=-KLOCE(ID)                                              ASRE  45
      GO TO 50                                                          ASRE  46
40    KLOCE(ID)=0                                                       ASRE  47
50    CONTINUE                                                          ASRE  48
      CALL ASSEL(0,1,IDLE,NSYM,KLOCE,KLD,VKE,VFE,VKGS,VKGD,VKGI,VREAC)  ASRE  49
60    ITPE1=ITPE                                                        ASRE  50
      RETURN                                                            ASRE  51
      END                                                               ASRE  52
 
      SUBROUTINE ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                 ELLB   1
C=======================================================================ELLB   2
C     CALCUL DES GRANDEURS ELEMENTAIRES POUR TOUS LES TYPES D'ELEMENTS  ELLB   3
C=======================================================================ELLB   4
      IMPLICIT REAL*8(A-H,O-Z)                                          ELLB   5
      COMMON/RGDT/IEL,ITPE                                              ELLB   6
      DIMENSION VCORE(1),VPRNE(1),VPREE(1),VDLE(1),VKE(1),VFE(1)        ELLB   7
C-----------------------------------------------------------------------ELLB   8
      GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, 90,100),ITPE              ELLB   9
C-------  ELEMENT DE TYPE 1                                             ELLB  10
10    CALL ELEM01(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ELLB  11
      GO TO 900                                                         ELLB  12
C-------  ELEMENT DE TYPE 2                                             ELLB  13
20    CALL ELEM02(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ELLB  14
      GO TO 900                                                         ELLB  15
C-------  ELEMENT DE TYPE 3                                             ELLB  16
30    CALL ELEM03(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ELLB  17
      GO TO 900                                                         ELLB  18
C-------  ELEMENT DE TYPE 4                                             ELLB  19
40    CALL ELEM04(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ELLB  20
      GO TO 900                                                         ELLB  21
C-------  ELEMENT DE TYPE 5                                             ELLB  22
50    CALL ELEM05(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ELLB  23
      GO TO 900                                                         ELLB  24
C-------  ELEMENT DE TYPE 6                                             ELLB  25
60    CALL ELEM06(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ELLB  26
      GO TO 900                                                         ELLB  27
C-------  ELEMENT DE TYPE 7                                             ELLB  28
70    CALL ELEM07(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ELLB  29
      GO TO 900                                                         ELLB  30
C-------  ELEMENT DE TYPE 8                                             ELLB  31
80    CALL ELEM08(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ELLB  32
      GO TO 900                                                         ELLB  33
C-------  ELEMENT DE TYPE 9                                             ELLB  34
90    CALL ELEM09(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ELLB  35
      GO TO 900                                                         ELLB  36
C-------  ELEMENT DE TYPE 10                                            ELLB  37
100   CALL ELEM10(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ELLB  38
      GO TO 900                                                         ELLB  39
C-------  AUTRES ELEMENTS                                               ELLB  40
C     ........                                                          ELLB  41
900   RETURN                                                            ELLB  42
      END                                                               ELLB  43
 
      SUBROUTINE ASSEL(IKG,IFG,IDLE,NSYM,KLOCE,KLD,VKE,VFE,VKGS,        ASSE   1
     1  VKGD,VKGI,VFG)                                                  ASSE   2
C=======================================================================ASSE   3
C     ASSEMBLAGE D'UNE MATRICE ET/OU D'UN VECTEUR ELEMENTAIRE           ASSE   4
C     (MATRICE SYMETRIQUE OU NON)                                       ASSE   5
C       ENTREES                                                         ASSE   6
C          IKG     SI IKG.EQ.1 ASSEMBLAGE DE LA MATRICE ELEMENTAIRE KE  ASSE   7
C          IFG     SI IFG.EQ.1 ASSEMBLAGE DU VECTEUR ELEMENTAIRE FE     ASSE   8
C          IDLE    NOMBRE DE D.L. DE L'ELEMENT                          ASSE   9
C          NSYM    0=PROBLEME SYMETRIQUE, 1=PROBLEME NON SYMETRIQUE     ASSE  10
C          KLOCE   VECTEUR DE LOCALISATION DE L'ELEMENT                 ASSE  11
C          KLD     HAUTEURS CUMULEES DE COLONNES DE KG                  ASSE  12
C          VKE     MATRICE ELEMENTAIRE KE(PLEINE OU TRIANGLE SUPERIEUR  ASSE  13
C                  PAR COLONNES DESCENDANTES)                           ASSE  14
C          VFE     VECTEUR ELEMENTAIRE FE                               ASSE  15
C       SORTIES                                                         ASSE  16
C          VKGS,VKGD,VKGI    MATRICE GLOBALE (LIGNE DE CIEL)            ASSE  17
C                  (SYMETRIQUE OU NON)                                  ASSE  18
C          VFG     VECTEUR SOLLICITATIONS GLOBAL                        ASSE  19
C=======================================================================ASSE  20
      IMPLICIT REAL*8(A-H,O-Z)                                          ASSE  21
      DIMENSION KLOCE(1),KLD(1),VKE(1),VFE(1),VKGS(1),VKGD(1),          ASSE  22
     1  VKGI(1),VFG(1)                                                  ASSE  23
C-----------------------------------------------------------------------ASSE  24
C                                                                       ASSE  25
C-------  ASSEMBLAGE DE LA MATRICE ELEMENTAIRE                          ASSE  26
C                                                                       ASSE  27
      IF(IKG.NE.1) GO TO 100                                            ASSE  28
      IEQ0=IDLE                                                         ASSE  29
      IEQ1=1                                                            ASSE  30
C-------  POUR CHAQUE COLONNE DE KE                                     ASSE  31
      DO 90 JD=1,IDLE                                                   ASSE  32
      IF(NSYM.NE.1) IEQ0=JD                                             ASSE  33
      JL=KLOCE(JD)                                                      ASSE  34
      IF(JL) 90,90,10                                                   ASSE  35
10    I0=KLD(JL+1)                                                      ASSE  36
      IEQ=IEQ1                                                          ASSE  37
      IQ=1                                                              ASSE  38
C-------  POUR CHAQUE LIGNE DE KE                                       ASSE  39
      DO 80 ID=1,IDLE                                                   ASSE  40
      IL=KLOCE(ID)                                                      ASSE  41
      IF(NSYM.EQ.1) GO TO 30                                            ASSE  42
      IF(ID-JD) 30,20,20                                                ASSE  43
20    IQ=ID                                                             ASSE  44
30    IF(IL) 80,80,40                                                   ASSE  45
40    IJ=JL-IL                                                          ASSE  46
      IF(IJ) 70,50,60                                                   ASSE  47
C-------  TERMES DIAGONAUX DE KG                                        ASSE  48
50    VKGD(IL)=VKGD(IL)+VKE(IEQ)                                        ASSE  49
      GO TO 80                                                          ASSE  50
C-------  TERMES DU TRIANGLE SUPERIEUR DE KG                            ASSE  51
60    I=I0-IJ                                                           ASSE  52
      VKGS(I)=VKGS(I)+VKE(IEQ)                                          ASSE  53
      GO TO 80                                                          ASSE  54
C-------  TERMES DU TRIANGLE INFERIEUR DE KG                            ASSE  55
70    IF(NSYM.NE.1) GO TO 80                                            ASSE  56
      I=KLD(IL+1)+IJ                                                    ASSE  57
      VKGI(I)=VKGI(I)+VKE(IEQ)                                          ASSE  58
80    IEQ=IEQ+IQ                                                        ASSE  59
90    IEQ1=IEQ1+IEQ0                                                    ASSE  60
C                                                                       ASSE  61
C-------  ASSEMBLAGE DU VECTEUR ELEMENTAIRE                             ASSE  62
C                                                                       ASSE  63
100   IF(IFG.NE.1) GO TO 130                                            ASSE  64
      DO 120 ID=1,IDLE                                                  ASSE  65
      IL=KLOCE(ID)                                                      ASSE  66
      IF(IL) 120,120,110                                                ASSE  67
110   VFG(IL)=VFG(IL)+VFE(ID)                                           ASSE  68
120   CONTINUE                                                          ASSE  69
130   RETURN                                                            ASSE  70
      END                                                               ASSE  71
 
      SUBROUTINE MODFG(IDLE,NSYM,KLOCE,VDIMP,VKE,VFG)                   MODF   1
C=======================================================================MODF   2
C     MODIFICATION DU VECTEUR FG POUR TENIR COMPTE DES DEGRES DE LIBERTEMODF   3
C     IMPOSES NON NULS CORRESPONDANT A UN ELEMENT                       MODF   4
C       ENTREES                                                         MODF   5
C          IDLE    NOMBRE DE D.L. DE L'ELEMENT                          MODF   6
C          NSYM    0=PROBLEME SYMETRIQUE, 1=PROBLEME NON SYMETRIQUE     MODF   7
C          KLOCE   VECTEUR DE LOCALISATION DE L'ELEMENT                 MODF   8
C          VDIMP   VALEURS DES D.L. IMPOSES                             MODF   9
C          VKE     MATRICE ELEMENTAIRE (PLEINE OU TRIANGLE SUPERIEUR PARMODF  10
C                  COLONNES DESCENDANTES)                               MODF  11
C       SORTIE                                                          MODF  12
C          VFG     VECTEUR SOLLICITATIONS GLOBAL                        MODF  13
C=======================================================================MODF  14
      IMPLICIT REAL*8(A-H,O-Z)                                          MODF  15
      DIMENSION KLOCE(1),VDIMP(1),VKE(1),VFG(1)                         MODF  16
      DATA ZERO/0.D0/                                                   MODF  17
C-----------------------------------------------------------------------MODF  18
      IEQ0=IDLE                                                         MODF  19
      IEQ1=1                                                            MODF  20
C-------  POUR CHAQUE LIGNE DE LA MATRICE ELEMENTAIRE                   MODF  21
      DO 50 JD=1,IDLE                                                   MODF  22
      IF(NSYM.NE.1) IEQ0=JD                                             MODF  23
      IEQ=IEQ1                                                          MODF  24
      JL=KLOCE(JD)                                                      MODF  25
      IQ=1                                                              MODF  26
      IF(JL) 10,50,50                                                   MODF  27
10    JL=-JL                                                            MODF  28
      DIMP=VDIMP(JL)                                                    MODF  29
      IF(DIMP.EQ.ZERO) GO TO 50                                         MODF  30
C-------  POUR CHAQUE COLONNE DE LA MATRICE ELEMENTAIRE                 MODF  31
      DO 40 ID=1,IDLE                                                   MODF  32
      IL=KLOCE(ID)                                                      MODF  33
      IF(NSYM.EQ.1) GO TO 30                                            MODF  34
      IF(ID-JD) 30,20,20                                                MODF  35
20    IQ=ID                                                             MODF  36
30    IF(IL.GT.0) VFG(IL)=VFG(IL)-VKE(IEQ)*DIMP                         MODF  37
40    IEQ=IEQ+IQ                                                        MODF  38
50    IEQ1=IEQ1+IEQ0                                                    MODF  39
      RETURN                                                            MODF  40
      END                                                               MODF  41
 
      SUBROUTINE PRPVTS(VKGD)                                           PRPV   1
C=======================================================================PRPV   2
C     CALCUL ET IMPRESSION DES PIVOTS ET DU DETERMINANT DE LA MATRICE KGPRPV   3
C=======================================================================PRPV   4
      IMPLICIT REAL*8(A-H,O-Z)                                          PRPV   5
      COMMON/RESO/NEQ                                                   PRPV   6
      COMMON/ES/M,MR,MP                                                 PRPV   7
      DIMENSION VKGD(1)                                                 PRPV   8
      DATA UN/1.D0/,GROS/1.D38/                                         PRPV   9
      ABS(X)=DABS(X)                                                    PRPV  10
C-----------------------------------------------------------------------PRPV  11
      X1=GROS                                                           PRPV  12
      X2=GROS                                                           PRPV  13
      DET=UN                                                            PRPV  14
      IDET=0                                                            PRPV  15
C-------  IMPRESSION DES PIVOTS DE KG                                   PRPV  16
      IF(M.GE.2) WRITE(MP,2000)(VKGD(I),I=1,NEQ)                        PRPV  17
2000  FORMAT(/' PIVOTS DE LA MATRICE GLOBALE'/(1X,10E12.5))             PRPV  18
      DO 50 I=1,NEQ                                                     PRPV  19
C-------  PIVOT MINIMUM EN VALEUR ABSOLUE                               PRPV  20
      X=ABS(VKGD(I))                                                    PRPV  21
      IF(X.GT.X1) GO TO 10                                              PRPV  22
      X1=X                                                              PRPV  23
      I1=I                                                              PRPV  24
C-------  PIVOT MINIMUM EN VALEUR ALGEBRIQUE                            PRPV  25
      X=VKGD(I)                                                         PRPV  26
10    IF(X.GT.X2) GO TO 20                                              PRPV  27
      X2=X                                                              PRPV  28
      I2=I                                                              PRPV  29
C-------  DETERMINANT (LE LIMITER A 10 PUISSANCE + OU - 10)             PRPV  30
20    DET=DET*VKGD(I)                                                   PRPV  31
30    DET1=ABS(DET)                                                     PRPV  32
      IF(DET1.LT.1.D10) GO TO 40                                        PRPV  33
      DET=DET*1.D-10                                                    PRPV  34
      IDET=IDET+10                                                      PRPV  35
40    IF(DET1.GT.1.D-10) GO TO 50                                       PRPV  36
      DET=DET*1.D10                                                     PRPV  37
      IDET=IDET-10                                                      PRPV  38
      GO TO 30                                                          PRPV  39
50    CONTINUE                                                          PRPV  40
C-------  IMPRESSIONS                                                   PRPV  41
      WRITE(MP,2010) X1,I1,X2,I2,DET,IDET                               PRPV  42
2010  FORMAT(/15X,'PIVOT MINIMUM VALEUR ABSOLUE   =',E12.5,' EQUATION:',PRPV  43
     1  I5   /29X,              'VALEUR ALGEBRIQUE=',E12.5,' EQUATION:',PRPV  44
     2  I5   /29X,              'DETERMINANT      =',E12.5,' * 10 ** ', PRPV  45
     3  I5/)                                                            PRPV  46
      RETURN                                                            PRPV  47
      END                                                               PRPV  48
 
      SUBROUTINE PRRESD(VKGS,VKGD,VKGI,VFG,KLD,VRES)                    PRRE   1
C=======================================================================PRRE   2
C     CALCUL ET IMPRESSION DES RESIDUS DE RESOLUTION K.U - F            PRRE   3
C=======================================================================PRRE   4
      IMPLICIT REAL*8(A-H,O-Z)                                          PRRE   5
      COMMON/ASSE/NSYM,NKG                                              PRRE   6
      COMMON/RESO/NEQ,NRES,MRES                                         PRRE   7
      COMMON/ES/M,MR,MP,M1,M2,M3                                        PRRE   8
      DIMENSION VKGS(1),VKGD(1),VKGI(1),VFG(1),KLD(1),VRES(1)           PRRE   9
      DATA ZERO/0.D0/                                                   PRRE  10
      ABS(X)=DABS(X)                                                    PRRE  11
C-----------------------------------------------------------------------PRRE  12
      REWIND M3                                                         PRRE  13
C-------  SAUTER LE VECTEUR FG NON MODIFIE PAR LES C.L. SUR FICHIER M3  PRRE  14
      READ(M3) (VRES(I),I=1,NEQ)                                        PRRE  15
C-------  LIRE LE VECTEUR MODIFIE PAR LES C.L. ET LA MATRICE KG         PRRE  16
      READ(M3) (VRES(I),I=1,NEQ)                                        PRRE  17
      READ(M3) (VKGS(I),I=1,NKG),(VKGD(I),I=1,NEQ)                      PRRE  18
      IF(NSYM.EQ.1) READ(M3) (VKGI(I),I=1,NKG)                          PRRE  19
C-------  CALCULER LE RESIDU DE RESOLUTION                              PRRE  20
      DO 10 I=1,NEQ                                                     PRRE  21
10    VRES(I)=-VRES(I)                                                  PRRE  22
      CALL MULKU(VKGS,VKGD,VKGI,KLD,VFG,NEQ,NSYM,VRES)                  PRRE  23
      DO 20 I=1,NEQ                                                     PRRE  24
20    VRES(I)=-VRES(I)                                                  PRRE  25
      X1=ZERO                                                           PRRE  26
      DO 30 I=1,NEQ                                                     PRRE  27
      X=ABS(VRES(I))                                                    PRRE  28
      IF(X1.GE.X) GO TO 30                                              PRRE  29
      X1=X                                                              PRRE  30
      I1=I                                                              PRRE  31
30    CONTINUE                                                          PRRE  32
      IF(M.GE.2) WRITE(MP,2000) (VRES(I),I=1,NEQ)                       PRRE  33
2000  FORMAT(/' RESIDUS DE RESOLUTION'/(1X,10E12.5))                    PRRE  34
      WRITE(MP,2010) X1,I1                                              PRRE  35
2010  FORMAT(/' RESIDU DE RESOLUTION MAX.=',E12.5,' EQUATION',I5)       PRRE  36
      RETURN                                                            PRRE  37
      END                                                               PRRE  38
 
      SUBROUTINE PRSOL(KDLNC,VCORG,VDIMP,KNEQ,VFG)                      PRSO   1
C=======================================================================PRSO   2
C     IMPRESSION DE LA SOLUTION                                         PRSO   3
C=======================================================================PRSO   4
      IMPLICIT REAL*8(A-H,O-Z)                                          PRSO   5
      COMMON/COOR/NDIM,NNT                                              PRSO   6
      COMMON/ES/M,MR,MP                                                 PRSO   7
      COMMON/TRVL/V(10),FX(10)                                          PRSO   8
      DIMENSION VDIMP(1),KDLNC(1),VCORG(1),KNEQ(1),VFG(1)               PRSO   9
      DATA RF/4H *  /,RL/4H    /,ZERO/0.D0/                             PRSO  10
C-----------------------------------------------------------------------PRSO  11
      X2=ZERO                                                           PRSO  12
      X3=ZERO                                                           PRSO  13
      WRITE(MP,2000)                                                    PRSO  14
2000  FORMAT(/' NOEUDS',4X,'X',11X,'Y',11X,'Z',10X,'DEGRES DE LIBERTE (*PRSO  15
     1 = IMPOSE)'/)                                                     PRSO  16
      I2=0                                                              PRSO  17
      DO 50 IN=1,NNT                                                    PRSO  18
      I1=I2+1                                                           PRSO  19
      I2=I2+NDIM                                                        PRSO  20
      ID1=KDLNC(IN)+1                                                   PRSO  21
      ID2=KDLNC(IN+1)                                                   PRSO  22
      ID=ID2-ID1+1                                                      PRSO  23
      IF(ID2.LT.ID1) GO TO 50                                           PRSO  24
      X1=VCORG(I1)                                                      PRSO  25
      IF(NDIM.GE.2) X2=VCORG(I1+1)                                      PRSO  26
      IF(NDIM.GE.3) X3=VCORG(I1+2)                                      PRSO  27
      J=ID1                                                             PRSO  28
      DO 40 I=1,ID                                                      PRSO  29
      JJ=KNEQ(J)                                                        PRSO  30
      IF(JJ) 10,20,30                                                   PRSO  31
10    V(I)=VDIMP(-JJ)                                                   PRSO  32
      FX(I)=RF                                                          PRSO  33
      GO TO 40                                                          PRSO  34
20    V(I)=ZERO                                                         PRSO  35
      FX(I)=RF                                                          PRSO  36
      GO TO 40                                                          PRSO  37
30    V(I)=VFG(JJ)                                                      PRSO  38
      FX(I)=RL                                                          PRSO  39
40    J=J+1                                                             PRSO  40
      WRITE(MP,2010)IN,X1,X2,X3,(V(II),FX(II),II=1,ID)                  PRSO  41
2010  FORMAT(1X,I5,3E12.5,5X,5(E12.5,A4)/47X,5(E12.5,A4))               PRSO  42
50    CONTINUE                                                          PRSO  43
      RETURN                                                            PRSO  44
      END                                                               PRSO  45
 
      SUBROUTINE DLELM(KLOCE,VDLG,VDIMP,VDLE)                           DLEL   1
C=======================================================================DLEL   2
C     EXTRACTION DES D.L. D'UN ELEMENT                                  DLEL   3
C=======================================================================DLEL   4
      IMPLICIT REAL*8(A-H,O-Z)                                          DLEL   5
      COMMON/RGDT/IEL,INUL(3),IDLE                                      DLEL   6
      COMMON/ES/M,MR,MP                                                 DLEL   7
      DIMENSION KLOCE(1),VDLG(1),VDIMP(1),VDLE(1)                       DLEL   8
      DATA ZERO/0.D0/                                                   DLEL   9
C-----------------------------------------------------------------------DLEL  10
      DO 40 ID=1,IDLE                                                   DLEL  11
      IL=KLOCE(ID)                                                      DLEL  12
      IF(IL) 10,20,30                                                   DLEL  13
10    VDLE(ID)=VDIMP(-IL)                                               DLEL  14
      GO TO 40                                                          DLEL  15
20    VDLE(ID)=ZERO                                                     DLEL  16
      GO TO 40                                                          DLEL  17
30    VDLE(ID)=VDLG(IL)                                                 DLEL  18
40    CONTINUE                                                          DLEL  19
      IF(M.GE.2) WRITE(MP,2000) IEL,(VDLE(ID),ID=1,IDLE)                DLEL  20
2000  FORMAT(' DEGRES DE LIBERTE DE L ELEMENT ',I5/(1X,10E12.5))        DLEL  21
      RETURN                                                            DLEL  22
      END                                                               DLEL  23
 
      SUBROUTINE MULKU(VKGS,VKGD,VKGI,KLD,VFG,NEQ,NSYM,VRES)            MULK   1
C=======================================================================MULK   2
C     CE SOUS-PROGRAMME AJOUTE AU VECTEUR RES LE PRODUIT DE LA          MULK   3
C     MATRICE KG PAR LE VECTEUR FG                                      MULK   4
C       ENTREES                                                         MULK   5
C          VKGS,VKGD,VKGI  MATRICE KG STOCKEE PAR LIGNE DE CIEL (SYM.   MULK   6
C                          OU NON SYM.)                                 MULK   7
C          KLD     TABLE DES POINTEURS DES HAUTS DE COLONNES DE KG      MULK   8
C          VFG     VECTEUR FG                                           MULK   9
C          NEQ     DIMENSION DES VECTEURS FG ET RES                     MULK  10
C          NSYM    .EQ.1 SI LE PROBLEME N'EST PAS SYMETRIQUE            MULK  11
C          VRES    VECTEUR RES                                          MULK  12
C       SORTIE                                                          MULK  13
C          VRES    VECTEUR RES                                          MULK  14
C=======================================================================MULK  15
      IMPLICIT REAL*8(A-H,O-Z)                                          MULK  16
      DIMENSION VKGS(1),VKGD(1),VKGI(1),KLD(1),VFG(1),VRES(1)           MULK  17
C-----------------------------------------------------------------------MULK  18
C-------  POUR CHAQUE COLONNE DE LA MATRICE KG                          MULK  19
      DO 20 IK=1,NEQ                                                    MULK  20
      JHK=KLD(IK)                                                       MULK  21
      JHK1=KLD(IK+1)                                                    MULK  22
      LHK=JHK1-JHK                                                      MULK  23
C-------  TERME DIAGONAL                                                MULK  24
      C=VKGD(IK)*VFG(IK)                                                MULK  25
      IF(LHK.LE.0) GO TO 20                                             MULK  26
      I0=IK-LHK                                                         MULK  27
C-------  TERMES DE LIGNE                                               MULK  28
      IF(NSYM.NE.1) C=C+SCAL(VKGS(JHK),VFG(I0),LHK)                     MULK  29
      IF(NSYM.EQ.1) C=C+SCAL(VKGI(JHK),VFG(I0),LHK)                     MULK  30
C-------  TERMES DE COLONNE                                             MULK  31
      J=JHK                                                             MULK  32
      I1=IK-1                                                           MULK  33
      DO 10 IJ=I0,I1                                                    MULK  34
      VRES(IJ)=VRES(IJ)+VKGS(J)*VFG(IK)                                 MULK  35
10    J=J+1                                                             MULK  36
20    VRES(IK)=VRES(IK)+C                                               MULK  37
      RETURN                                                            MULK  38
      END                                                               MULK  39
C++++++  FIN FIGURE 6.22
C++++++  DEBUT FIGURE 5.10
      SUBROUTINE GAUSS(IPGKED,NDIM,VKPG,VCPG,IPG)                       GAUS   1
C=======================================================================GAUS   2
C     CREE LES TABLES DE COORDONNEES ET DE POIDS DES POINTS DE GAUSS    GAUS   3
C     (1,2 ET 3 DIMENSIONS)(1,2,3 OU 4 P.G. PAR DIMENSION)              GAUS   4
C       ENTREES                                                         GAUS   5
C          IPGKED  NOMBRE DE POINTS DANS LES DIRECTIONS KSI,ETA,DZETA   GAUS   6
C          NDIM    NOMBRE DE DIMENSIONS (1,2 OU 3)                      GAUS   7
C       SORTIES                                                         GAUS   8
C          VKPG    COORDONNEES DES POINTS DE GAUSS                      GAUS   9
C          VCPG    POIDS DES POINTS DE GAUSS                            GAUS  10
C          IPG     NOMBRE TOTAL DE POINTS DE GAUSS                      GAUS  11
C=======================================================================GAUS  12
      IMPLICIT REAL*8(A-H,O-Z)                                          GAUS  13
      DIMENSION IPGKED(1),VKPG(1),VCPG(1),G(10),P(10),INDIC(4)          GAUS  14
      DATA INDIC/1,2,4,7/                                               GAUS  15
      DATA G/0.0D0,-.577350269189626D0,.577350269189626D0,              GAUS  16
     1       -.774596669241483D0,0.0D0,.774596669241483D0,              GAUS  17
     2       -.861136311594050D0,-.339981043584860D0,                   GAUS  18
     3       .339981043584860D0,.861136311594050D0/                     GAUS  19
      DATA P/2.0D0,1.0D0,1.0D0,                                         GAUS  20
     1      0.555555555555556D0,0.888888888888889D0,0.555555555555556D0,GAUS  21
     2       .347854845137450D0,.652145154862550D0,                     GAUS  22
     3       .652145154862550D0,.347854845137450D0/                     GAUS  23
C-----------------------------------------------------------------------GAUS  24
      II=IPGKED(1)                                                      GAUS  25
      IMIN=INDIC(II)                                                    GAUS  26
      IMAX=IMIN+II-1                                                    GAUS  27
      IF(NDIM-2) 10,20,30                                               GAUS  28
C-------  1 DIMENSION                                                   GAUS  29
10    IPG=0                                                             GAUS  30
      DO 15 I=IMIN,IMAX                                                 GAUS  31
      IPG=IPG+1                                                         GAUS  32
      VKPG(IPG)=G(I)                                                    GAUS  33
15    VCPG(IPG)=P(I)                                                    GAUS  34
      RETURN                                                            GAUS  35
C-------  2 DIMENSIONS                                                  GAUS  36
20    II=IPGKED(2)                                                      GAUS  37
      JMIN=INDIC(II)                                                    GAUS  38
      JMAX=JMIN+II-1                                                    GAUS  39
      IPG=0                                                             GAUS  40
      L=1                                                               GAUS  41
      DO 25 I=IMIN,IMAX                                                 GAUS  42
      DO 25 J=JMIN,JMAX                                                 GAUS  43
      IPG=IPG+1                                                         GAUS  44
      VKPG(L)=G(I)                                                      GAUS  45
      VKPG(L+1)=G(J)                                                    GAUS  46
      L=L+2                                                             GAUS  47
25    VCPG(IPG)=P(I)*P(J)                                               GAUS  48
      RETURN                                                            GAUS  49
C-------  3 DIMENSIONS                                                  GAUS  50
30    II=IPGKED(2)                                                      GAUS  51
      JMIN=INDIC(II)                                                    GAUS  52
      JMAX=JMIN+II-1                                                    GAUS  53
      II=IPGKED(3)                                                      GAUS  54
      KMIN=INDIC(II)                                                    GAUS  55
      KMAX=KMIN+II-1                                                    GAUS  56
      IPG=0                                                             GAUS  57
      L=1                                                               GAUS  58
      DO 35 I=IMIN,IMAX                                                 GAUS  59
      DO 35 J=JMIN,JMAX                                                 GAUS  60
      DO 35 K=KMIN,KMAX                                                 GAUS  61
      IPG=IPG+1                                                         GAUS  62
      VKPG(L)=G(I)                                                      GAUS  63
      VKPG(L+1)=G(J)                                                    GAUS  64
      VKPG(L+2)=G(K)                                                    GAUS  65
      L=L+3                                                             GAUS  66
35    VCPG(IPG)=P(I)*P(J)*P(K)                                          GAUS  67
      RETURN                                                            GAUS  68
      END                                                               GAUS  69
C++++++  FIN FIGURE 5.10
C++++++  DEBUT FIGURE 1.6
      SUBROUTINE PNINV(VKSI,KEXP,VP,K1,VPN)                             PNIN   1
C=======================================================================PNIN   2
C     CALCUL DE LA MATRICE PN INVERSE CONTENANT LES COEFFICIENTS        PNIN   3
C     DES FONCTIONS N                                                   PNIN   4
C       ENTREES    VKSI,KEXP,INEL,IDLE,ITPE,M,MP                        PNIN   5
C       TRAVAIL    VP,K1                                                PNIN   6
C       SORTIE     VPN                                                  PNIN   7
C=======================================================================PNIN   8
      IMPLICIT REAL*8(A-H,O-Z)                                          PNIN   9
      COMMON/COOR/NDIM                                                  PNIN  10
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGPNIN  11
      COMMON/ES/M,MR,MP                                                 PNIN  12
      DIMENSION VKSI(1),KEXP(1),VP(1),K1(1),VPN(1),KDER(3)              PNIN  13
      DATA ZERO/0.D0/,KDER/3*0/                                         PNIN  14
C-----------------------------------------------------------------------PNIN  15
C                                                                       PNIN  16
C.......  CONSTRUCTION DE LA MATRICE PN (VALABLE POUR TOUT ELEMENT DE   PNIN  17
C          TYPE LAGRANGE)                                               PNIN  18
C                                                                       PNIN  19
      I0=1                                                              PNIN  20
      I1=1                                                              PNIN  21
      DO 20 IN=1,INEL                                                   PNIN  22
      CALL BASEP(VKSI(I1),KEXP,KDER,VP)                                 PNIN  23
      I2=I0                                                             PNIN  24
      DO 10 IJ=1,INEL                                                   PNIN  25
      VPN(I2)=VP(IJ)                                                    PNIN  26
10    I2=I2+INEL                                                        PNIN  27
      I0=I0+1                                                           PNIN  28
20    I1=I1+NDIM                                                        PNIN  29
C                                                                       PNIN  30
C.......  FIN DE LA CONSTRUCTION DE PN                                  PNIN  31
C                                                                       PNIN  32
C-------  IMPRESSION DE PN                                              PNIN  33
      IF(M.LT.4) GO TO 40                                               PNIN  34
      WRITE(MP,2000)                                                    PNIN  35
2000  FORMAT(/' MATRICE PN'/)                                           PNIN  36
      ID=(INEL-1)*INEL                                                  PNIN  37
      DO 30 I0=1,INEL                                                   PNIN  38
      I1=I0+ID                                                          PNIN  39
30    WRITE(MP,2010) (VPN(IJ),IJ=I0,I1,INEL)                            PNIN  40
2010  FORMAT(1X,10E13.5/(14X,9E13.5))                                   PNIN  41
C-------  INVERSION DE PN                                               PNIN  42
40    CALL INVERS(VPN,INEL,INEL,K1,DET)                                 PNIN  43
      IF(DET.NE.ZERO) GO TO 50                                          PNIN  44
      WRITE(MP,2020) ITPE                                               PNIN  45
2020  FORMAT(' *** ERREUR, PN SINGULIERE, ELEMENT DE TYPE:',I3)         PNIN  46
      STOP                                                              PNIN  47
C-------  IMPRESSION DE PN INVERSE                                      PNIN  48
50    IF(M.LT.4) GO TO 70                                               PNIN  49
      WRITE(MP,2030)                                                    PNIN  50
2030  FORMAT(/' MATRICE PN INVERSE'/)                                   PNIN  51
      DO 60 I0=1,INEL                                                   PNIN  52
      I1=I0+ID                                                          PNIN  53
60    WRITE(MP,2010) (VPN(IJ),IJ=I0,I1,INEL)                            PNIN  54
70    RETURN                                                            PNIN  55
      END                                                               PNIN  56
  
      SUBROUTINE NI(VKSI,KEXP,KDER,VP,VPN,VNI)                          NI     1
C=======================================================================NI     2
C     CALCUL DES FONCTIONS N OU DE LEURS DERIVEES AU POINT DE           NI     3
C     COORDONNES VKSI SUR L'ELEMENT DE REFERENCE                        NI     4
C       ENTREES    VKSI,KEXP,KDER,VP,VPN,IDLE,M,MP                      NI     5
C       SORTIE     VNI                                                  NI     6
C=======================================================================NI     7
      IMPLICIT REAL*8(A-H,O-Z)                                          NI     8
      COMMON/COOR/NDIM                                                  NI     9
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGNI    10
      COMMON/ES/M,MR,MP                                                 NI    11
      DIMENSION VKSI(1),KEXP(1),KDER(1),VP(1),VPN(1),VNI(1)             NI    12
      DATA ZERO/0.D0/                                                   NI    13
C-----------------------------------------------------------------------NI    14
C-------  CALCUL DE LA BASE POLYNOMIALE AU POINT VKSI                   NI    15
      CALL BASEP(VKSI,KEXP,KDER,VP)                                     NI    16
C-------  PRODUIT P*PN INVERSE                                          NI    17
      I0=1                                                              NI    18
      DO 20 IJ=1,INEL                                                   NI    19
      I1=I0                                                             NI    20
      C=ZERO                                                            NI    21
      DO 10 II=1,INEL                                                   NI    22
      C=C+VP(II)*VPN(I1)                                                NI    23
10    I1=I1+1                                                           NI    24
      VNI(IJ)=C                                                         NI    25
20    I0=I0+INEL                                                        NI    26
C-------  IMPRESSION DES FONCTIONS N                                    NI    27
      IF(M.LT.3) GO TO 30                                               NI    28
      WRITE(MP,2000) (KDER(I),I=1,NDIM)                                 NI    29
2000  FORMAT(/' DERIVEE DE N D ORDRE ',3I2)                             NI    30
      WRITE(MP,2010) (VKSI(I),I=1,NDIM)                                 NI    31
2010  FORMAT(14X,'AU POINT ',3E13.5)                                    NI    32
      WRITE(MP,2020) (VNI(I),I=1,INEL)                                  NI    33
2020  FORMAT(/(1X,10E13.5))                                             NI    34
30    RETURN                                                            NI    35
      END                                                               NI    36
  
      SUBROUTINE BASEP(VKSI,KEXP,KDER,VP)                               BASE   1
C=======================================================================BASE   2
C     CALCUL D'UNE BASE POLYNOMIALE ET DE SES DERIVEES AU POINT VKSI    BASE   3
C       ENTREES    VKSI,KEXP,KDER,IDLE,IDEG,NDIM,M,MP                   BASE   4
C       SORTIE     VP                                                   BASE   5
C=======================================================================BASE   6
      IMPLICIT REAL*8(A-H,O-Z)                                          BASE   7
      COMMON/COOR/NDIM                                                  BASE   8
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGBASE   9
      COMMON/ES/M,MR,MP                                                 BASE  10
      DIMENSION VKSI(1),KEXP(1),KDER(1),VP(1)                           BASE  11
      DIMENSION PUISS(3,10)                                             BASE  12
      DATA ZERO/0.D0/,UN/1.D0/                                          BASE  13
C-----------------------------------------------------------------------BASE  14
C-------  CALCUL DES PUISSANCES SUCCESSIVES DE KSI,ETA,DZETA            BASE  15
      DO 10 I=1,NDIM                                                    BASE  16
      PUISS(I,1)=UN                                                     BASE  17
      DO 10 ID=1,IDEG                                                   BASE  18
10    PUISS(I,ID+1)=PUISS(I,ID)*VKSI(I)                                 BASE  19
C-------  DERIVEES D ORDRE KDER EN KSI,ETA,DZETA                        BASE  20
      DO 50 IDL=1,INEL                                                  BASE  21
      C1=UN                                                             BASE  22
      I0=(IDL-1)*NDIM                                                   BASE  23
      DO 30 I=1,NDIM                                                    BASE  24
      IDR=KDER(I)                                                       BASE  25
      I0=I0+1                                                           BASE  26
      IXP=KEXP(I0)+1                                                    BASE  27
      J=IXP-IDR                                                         BASE  28
      IF(J.LE.0) GO TO 40                                               BASE  29
      IF(IDR.LE.0) GO TO 30                                             BASE  30
      DO 20 ID=1,IDR                                                    BASE  31
20    C1=C1*(IXP-ID)                                                    BASE  32
30    C1=C1*PUISS(I,J)                                                  BASE  33
      GO TO 50                                                          BASE  34
40    C1=ZERO                                                           BASE  35
50    VP(IDL)=C1                                                        BASE  36
C-------  IMPRESSION DE LA BASE POLYNOMIALE                             BASE  37
      IF(M.LT.4) GO TO 60                                               BASE  38
      WRITE(MP,2000) (KDER(I),I=1,NDIM)                                 BASE  39
2000  FORMAT(/' BASE POLYNOMIALE, DERIVEE D ORDRE ',3I2)                BASE  40
      WRITE(MP,2010) (VKSI(I),I=1,NDIM)                                 BASE  41
2010  FORMAT(19X,'AU POINT ',3E13.5)                                    BASE  42
      WRITE(MP,2020) (VP(I),I=1,INEL)                                   BASE  43
2020  FORMAT(/(1X,10E12.5))                                             BASE  44
60    RETURN                                                            BASE  45
      END                                                               BASE  46
 
      SUBROUTINE INVERS(VP,N,IVP,K,DET)                                 INVE   1
C=======================================================================INVE   2
C     INVERSION D'UNE MATRICE NON SYMETRIQUE AVEC RECHERCHE DE PIVOT    INVE   3
C     NON NUL SUR UNE COLONNE                                           INVE   4
C       ENTREES                                                         INVE   5
C          VP      MATRICE A INVERSER                                   INVE   6
C          N       ORDRE DE LA MATRICE A INVERSER                       INVE   7
C          IVP     DIMENSION DE LA MATRICE DANS LE PROGRAMME D'APPEL    INVE   8
C          K       VECTEUR DE TRAVAIL ENTIER DE LONGUEUR N              INVE   9
C       SORTIES                                                         INVE  10
C         VP       MATRICE INVERSEE                                     INVE  11
C         DET      DETERMINANT                                          INVE  12
C=======================================================================INVE  13
      IMPLICIT REAL*8(A-H,O-Z)                                          INVE  14
      DIMENSION VP(IVP,IVP),K(N)                                        INVE  15
      DATA ZERO/0.D0/,UN/1.D0/,EPS/1.D-13/                              INVE  16
      ABS(X)=DABS(X)                                                    INVE  17
C-----------------------------------------------------------------------INVE  18
      DET=UN                                                            INVE  19
      DO 5 I=1,N                                                        INVE  20
5     K(I)=I                                                            INVE  21
C-------  DEBUT DE L'INVERSION                                          INVE  22
      DO 80 II=1,N                                                      INVE  23
C-------  RECHERCHE D'UN PIVOT NON NUL SUR LA COLONNE II                INVE  24
      DO 10 I=II,N                                                      INVE  25
      PIV=VP(I,II)                                                      INVE  26
      IF(ABS(PIV).GT.EPS) GO TO 20                                      INVE  27
10    CONTINUE                                                          INVE  28
      DET=ZERO                                                          INVE  29
      RETURN                                                            INVE  30
C-------  ECHANGER LA LIGNE II ET LA LIGNE I                            INVE  31
20    DET=DET*PIV                                                       INVE  32
      IF(I.EQ.II) GO TO 40                                              INVE  33
      I1=K(II)                                                          INVE  34
      K(II)=K(I)                                                        INVE  35
      K(I)=I1                                                           INVE  36
      DO 30 J=1,N                                                       INVE  37
      C=VP(I,J)                                                         INVE  38
      VP(I,J)=VP(II,J)                                                  INVE  39
30    VP(II,J)=C                                                        INVE  40
      DET=-DET                                                          INVE  41
C-------  NORMALISER LA LIGNE DU PIVOT                                  INVE  42
40    C=UN/PIV                                                          INVE  43
      VP(II,II)=UN                                                      INVE  44
      DO 50 J=1,N                                                       INVE  45
50    VP(II,J)=VP(II,J)*C                                               INVE  46
C-------  ELIMINATION                                                   INVE  47
      DO 70 I=1,N                                                       INVE  48
      IF(I.EQ.II) GO TO 70                                              INVE  49
      C=VP(I,II)                                                        INVE  50
      VP(I,II)=ZERO                                                     INVE  51
      DO 60 J=1,N                                                       INVE  52
60    VP(I,J)=VP(I,J)-C*VP(II,J)                                        INVE  53
70    CONTINUE                                                          INVE  54
80    CONTINUE                                                          INVE  55
C-------  REORDONNER LES COLONNES DE L'INVERSE                          INVE  56
      DO 120 J=1,N                                                      INVE  57
C-------  CHERCHER J1 TEL QUE K(J1)=J                                   INVE  58
      DO 90 J1=J,N                                                      INVE  59
      JJ=K(J1)                                                          INVE  60
      IF(JJ.EQ.J) GO TO 100                                             INVE  61
90    CONTINUE                                                          INVE  62
100   IF(J.EQ.J1) GO TO 120                                             INVE  63
C-------  ECHANGER LES COLONNES J ET J1                                 INVE  64
      K(J1)=K(J)                                                        INVE  65
      DO 110 I=1,N                                                      INVE  66
      C=VP(I,J)                                                         INVE  67
      VP(I,J)=VP(I,J1)                                                  INVE  68
110   VP(I,J1)=C                                                        INVE  69
120   CONTINUE                                                          INVE  70
      RETURN                                                            INVE  71
      END                                                               INVE  72
C++++++  FIN FIGURE 1.6
C++++++  DEBUT FIGURE 1.9
      SUBROUTINE JACOB(VNI,VCORE,NDIM,INEL,VJ,VJ1,DETJ)                 JACB   1
C=======================================================================JACB   2
C     CALCUL DE LA MATRICE JACOBIENNE ,DE SON DETERMINANT,DE SON INVERSEJACB   3
C     (1,2,3 DIMENSIONS)                                                JACB   4
C       ENTREES                                                         JACB   5
C          VNI     DERIVEES DES FONCTIONS D'INTERPOLATION EN KSI,ETA,   JACB   6
C                  DZETA                                                JACB   7
C          VCORE   COORDONNEES DES NOEUDS DE L'ELEMENT                  JACB   8
C          NDIM    NOMBRE DE DIMENSIONS (1,2 OU 3)                      JACB   9
C          INEL    NOMBRE DE NOEUDS DE L'ELEMENT                        JACB  10
C       SORTIES                                                         JACB  11
C          VJ      MATRICE JACOBIENNE                                   JACB  12
C          VJ1     MATRICE JACOBIENNE INVERSE                           JACB  13
C          DETJ    DETERMINANT DE LA MATRICE JACOBIENNE                 JACB  14
C=======================================================================JACB  15
      IMPLICIT REAL*8(A-H,O-Z)                                          JACB  16
      DIMENSION VNI(INEL,1),VCORE(NDIM,1),VJ(1),VJ1(1)                  JACB  17
      DATA ZERO/0.D0/,UN/1.D0/                                          JACB  18
C-----------------------------------------------------------------------JACB  19
C-------  CONSTRUCTION DE LA MATRICE JACOBIENNE                         JACB  20
      J=1                                                               JACB  21
      DO 20 JJ=1,NDIM                                                   JACB  22
      DO 20 II=1,NDIM                                                   JACB  23
      C=ZERO                                                            JACB  24
      DO 10 IJ=1,INEL                                                   JACB  25
10    C=C+VNI(IJ,II)*VCORE(JJ,IJ)                                       JACB  26
      VJ(J)=C                                                           JACB  27
20    J=J+1                                                             JACB  28
C-------  INVERSION A 1,2 OU 3 DIMENSIONS                               JACB  29
      GO TO (40,50,60),NDIM                                             JACB  30
40    DETJ=VJ(1)                                                        JACB  31
      IF(DETJ.EQ.ZERO) RETURN                                           JACB  32
      VJ1(1)=UN/DETJ                                                    JACB  33
      RETURN                                                            JACB  34
50    DETJ=VJ(1)*VJ(4)-VJ(2)*VJ(3)                                      JACB  35
      IF(DETJ.EQ.ZERO) RETURN                                           JACB  36
      VJ1(1)=VJ(4)/DETJ                                                 JACB  37
      VJ1(2)=-VJ(2)/DETJ                                                JACB  38
      VJ1(3)=-VJ(3)/DETJ                                                JACB  39
      VJ1(4)=VJ(1)/DETJ                                                 JACB  40
      RETURN                                                            JACB  41
60    DETJ=VJ(1)*(VJ(5)*VJ(9)-VJ(8)*VJ(6))                              JACB  42
     1    +VJ(4)*(VJ(8)*VJ(3)-VJ(2)*VJ(9))                              JACB  43
     2    +VJ(7)*(VJ(2)*VJ(6)-VJ(5)*VJ(3))                              JACB  44
      IF(DETJ.EQ.ZERO) RETURN                                           JACB  45
      VJ1(1)=(VJ(5)*VJ(9)-VJ(6)*VJ(8))/DETJ                             JACB  46
      VJ1(2)=(VJ(3)*VJ(8)-VJ(2)*VJ(9))/DETJ                             JACB  47
      VJ1(3)=(VJ(2)*VJ(6)-VJ(3)*VJ(5))/DETJ                             JACB  48
      VJ1(4)=(VJ(7)*VJ(6)-VJ(4)*VJ(9))/DETJ                             JACB  49
      VJ1(5)=(VJ(1)*VJ(9)-VJ(7)*VJ(3))/DETJ                             JACB  50
      VJ1(6)=(VJ(4)*VJ(3)-VJ(6)*VJ(1))/DETJ                             JACB  51
      VJ1(7)=(VJ(4)*VJ(8)-VJ(7)*VJ(5))/DETJ                             JACB  52
      VJ1(8)=(VJ(2)*VJ(7)-VJ(8)*VJ(1))/DETJ                             JACB  53
      VJ1(9)=(VJ(1)*VJ(5)-VJ(4)*VJ(2))/DETJ                             JACB  54
      RETURN                                                            JACB  55
      END                                                               JACB  56
C++++++  FIN FIGURE 1.9
C++++++  DEBUT FIGURE 1.10
      SUBROUTINE DNIDX(VNI,VJ1,NDIM,INEL,VNIX)                          DNID   1
C=======================================================================DNID   2
C     CALCUL DES DERIVEES DES FONCTIONS D'INTERPOLATION PAR RAPPORT     DNID   3
C     A X,Y,Z                                                           DNID   4
C     (1,2 OU 3 DIMENSIONS)                                             DNID   5
C       ENTREES                                                         DNID   6
C          VNI     DERIVEES DES FONCTIONS D'INTERPOLATION EN KSI,ETA,   DNID   7
C                  DZETA                                                DNID   8
C          VJ1     INVERSE DU JACOBIEN                                  DNID   9
C          NDIM     NOMBRE DE DIMENSIONS (1,2 OU 3)                     DNID  10
C          INEL    NOMBRE DE FONCTIONS D'INTERPOLATION (DE NOEUDS)      DNID  11
C       SORTIE                                                          DNID  12
C          VNIX    DERIVEES DES FONCTIONS D'INTERPOLATION EN X,Y,Z      DNID  13
C=======================================================================DNID  14
      IMPLICIT REAL*8(A-H,O-Z)                                          DNID  15
      DIMENSION VNI(INEL,1),VJ1(NDIM,1),VNIX(INEL,1)                    DNID  16
      DATA ZERO/0.D0/                                                   DNID  17
C-----------------------------------------------------------------------DNID  18
      DO 20 I=1,NDIM                                                    DNID  19
      DO 20 J=1,INEL                                                    DNID  20
      C=ZERO                                                            DNID  21
      DO 10 IJ=1,NDIM                                                   DNID  22
10    C=C+VJ1(I,IJ)*VNI(J,IJ)                                           DNID  23
20    VNIX(J,I)=C                                                       DNID  24
      RETURN                                                            DNID  25
      END                                                               DNID  26
C++++++  FIN FIGURE 1.10
C++++++  DEBUT FIGURE 5.15                                                      
      SUBROUTINE SOL(VKGS,VKGD,VKGI,VFG,KLD,NEQ,MP,IFAC,ISOL,NSYM,ENERG)SOL    1
C=======================================================================SOL    2
C     RESOLUTION D'UN SYSTEME LINEAIRE SYMETRIQUE OU NON. LA MATRICE ESTSOL    3
C     STOCKEE PAR LIGNE DE CIEL,EN MEMOIRE DANS LES TABLES              SOL    4
C     VKGS,VKGD,VKGI                                                    SOL    5
C       ENTREES                                                         SOL    6
C          VKGS,VKGD,VKGI    MATRICE DU SYSTEME : PARTIES SUPERIEURE,   SOL    7
C                            DIAGONALE, INFERIEURE                      SOL    8
C          VFG               SECOND MEMBRE                              SOL    9
C          KLD               POINTEURS VERS LES HAUTS DE COLONNE        SOL   10
C          NEQ               NOMBRE D'EQUATIONS                         SOL   11
C          MP                UNITE LOGIQUE D'IMPRESSION                 SOL   12
C          IFAC              SI IFAC.EQ.1 TRIANGULARISATION DE          SOL   13
C                            LA MATRICE                                 SOL   14
C          ISOL              SI ISOL.EQ.1 CALCUL DE LA SOLUTION A       SOL   15
C                            PARTIR DE LA MATRICE TRIANGULARISEE        SOL   16
C          NSYM              INDICE DE PROBLEME NON SYMETRIQUE          SOL   17
C       SORTIES                                                         SOL   18
C          VKGS,VKGD,VKGI    MATRICE TRIANGULARISEE (SI IFAC.EQ.1)      SOL   19
C          VFG               SOLUTION (SI ISOL.EQ.1)                    SOL   20
C          ENERG             ENERGIE DU SYSTEME (SI NSYM.EQ.0)          SOL   21
C=======================================================================SOL   22
      IMPLICIT REAL*8 (A-H,O-Z)                                         SOL   23
      DIMENSION VKGS(1),VKGD(1),VKGI(1),VFG(1),KLD(1)                   SOL   24
      DATA ZERO/0.0D0/                                                  SOL   25
C-----------------------------------------------------------------------SOL   26
      IK=1                                                              SOL   27
      IF(VKGD(1).NE.ZERO) GO TO 10                                      SOL   28
      WRITE(MP,2000) IK                                                 SOL   29
      STOP                                                              SOL   30
10    ENERG=ZERO                                                        SOL   31
C                                                                       SOL   32
C-----  POUR CHAQUE COLONNE IK A MODIFIER                               SOL   33
C                                                                       SOL   34
      JHK=1                                                             SOL   35
      DO 100 IK=2,NEQ                                                   SOL   36
C-----  POINTEUR DU HAUT DE LA COLONNE SUIVANTE IK+1                    SOL   37
      JHK1=KLD(IK+1)                                                    SOL   38
C-----  HAUTEUR DE LA COLONNE IK (HORS TERMES SUPERIEUR ET DIAGONAL)    SOL   39
      LHK=JHK1-JHK                                                      SOL   40
      LHK1=LHK-1                                                        SOL   41
C-----  LIGNE DU PREMIER TERME A MODIFIER DANS LA COLONNE IK            SOL   42
      IMIN=IK-LHK1                                                      SOL   43
      IMIN1=IMIN-1                                                      SOL   44
C-------  LIGNE DU DERNIER TERME A MODIFIER DANS LA COLONNE IK          SOL   45
      IMAX=IK-1                                                         SOL   46
      IF(LHK1.LT.0) GO TO 100                                           SOL   47
      IF(IFAC.NE.1) GO TO 90                                            SOL   48
      IF(NSYM.EQ.1) VKGI(JHK)=VKGI(JHK)/VKGD(IMIN1)                     SOL   49
      IF(LHK1.EQ.0) GO TO 40                                            SOL   50
C                                                                       SOL   51
C-----  MODIFIER LES TERMES NON DIAGONAUX DE LA COLONNE IK              SOL   52
C                                                                       SOL   53
      JCK=JHK+1                                                         SOL   54
      JHJ=KLD(IMIN)                                                     SOL   55
C-----  POUR CHAQUE TERME PLACE EN JCK, CORRESPONDANT A LA COLONNE IJ   SOL   56
      DO 30 IJ=IMIN,IMAX                                                SOL   57
      JHJ1=KLD(IJ+1)                                                    SOL   58
C-----  NOMBRE DE TERMES MODIFICATIFS DU TERME PLACE EN JCK             SOL   59
      IC=MIN0(JCK-JHK,JHJ1-JHJ)                                         SOL   60
      IF(IC.LE.0.AND.NSYM.EQ.0) GO TO 20                                SOL   61
      C1=ZERO                                                           SOL   62
      IF(IC.LE.0) GO TO 17                                              SOL   63
      J1=JHJ1-IC                                                        SOL   64
      J2=JCK-IC                                                         SOL   65
      IF(NSYM.EQ.1) GO TO 15                                            SOL   66
      VKGS(JCK)=VKGS(JCK)-SCAL(VKGS(J1),VKGS(J2),IC)                    SOL   67
      GO TO 20                                                          SOL   68
15    VKGS(JCK)=VKGS(JCK)-SCAL(VKGI(J1),VKGS(J2),IC)                    SOL   69
      C1=SCAL(VKGS(J1),VKGI(J2),IC)                                     SOL   70
17    VKGI(JCK)=(VKGI(JCK)-C1)/VKGD(IJ)                                 SOL   71
20    JCK=JCK+1                                                         SOL   72
30    JHJ=JHJ1                                                          SOL   73
C                                                                       SOL   74
C-----  MODIFIER LE TERME DIAGONAL                                      SOL   75
C                                                                       SOL   76
40    JCK=JHK                                                           SOL   77
      CDIAG=ZERO                                                        SOL   78
      DO 70 IJ=IMIN1,IMAX                                               SOL   79
      C1=VKGS(JCK)                                                      SOL   80
      IF(NSYM.EQ.1) GO TO 50                                            SOL   81
      C2=C1/VKGD(IJ)                                                    SOL   82
      VKGS(JCK)=C2                                                      SOL   83
      GO TO 60                                                          SOL   84
50    C2=VKGI(JCK)                                                      SOL   85
60    CDIAG=CDIAG+C1*C2                                                 SOL   86
70    JCK=JCK+1                                                         SOL   87
      VKGD(IK)=VKGD(IK)-CDIAG                                           SOL   88
      IF(VKGD(IK)) 90,80,90                                             SOL   89
80    WRITE(MP,2000) IK                                                 SOL   90
2000  FORMAT(' *** ERREUR,PIVOT NUL EQUATION ',I5)                      SOL   91
      STOP                                                              SOL   92
C                                                                       SOL   93
C-----  RESOLUTION DU SYSTEME TRIANGULAIRE INFERIEUR                    SOL   94
C                                                                       SOL   95
   90 IF(ISOL.NE.1) GO TO 100                                           SOL   96
      IF(NSYM.NE.1) VFG(IK)=VFG(IK)-SCAL(VKGS(JHK),VFG(IMIN1),LHK)      SOL   97
      IF(NSYM.EQ.1) VFG(IK)=VFG(IK)-SCAL(VKGI(JHK),VFG(IMIN1),LHK)      SOL   98
100   JHK=JHK1                                                          SOL   99
      IF(ISOL.NE.1) RETURN                                              SOL  100
C                                                                       SOL  101
C-----  RESOLUTION DU SYSTEME DIAGONAL :                                SOL  102
C                                                                       SOL  103
      IF(NSYM.EQ.1) GO TO 120                                           SOL  104
      DO 110 IK=1,NEQ                                                   SOL  105
      C1=VKGD(IK)                                                       SOL  106
      C2=VFG(IK)/C1                                                     SOL  107
      VFG(IK)=C2                                                        SOL  108
110   ENERG=ENERG+C1*C2*C2                                              SOL  109
C                                                                       SOL  110
C-----  RESOLUTION DU SYSTEME TRIANGULAIRE SUPERIEUR                    SOL  111
C                                                                       SOL  112
120   IK=NEQ+1                                                          SOL  113
      JHK1=KLD(IK)                                                      SOL  114
130   IK=IK-1                                                           SOL  115
      IF(NSYM.EQ.1) VFG(IK)=VFG(IK)/VKGD(IK)                            SOL  116
      IF(IK.EQ.1) RETURN                                                SOL  117
      C1=VFG(IK)                                                        SOL  118
      JHK=KLD(IK)                                                       SOL  119
      JBK=JHK1-1                                                        SOL  120
      IF(JHK.GT.JBK)GO TO 150                                           SOL  121
      IJ=IK-JBK+JHK-1                                                   SOL  122
      DO 140 JCK=JHK,JBK                                                SOL  123
      VFG(IJ)=VFG(IJ)-VKGS(JCK)*C1                                      SOL  124
140   IJ=IJ+1                                                           SOL  125
150   JHK1=JHK                                                          SOL  126
      GO TO 130                                                         SOL  127
      END                                                               SOL  128
                                                                                
      FUNCTION SCAL(X,Y,N)                                              SCAL   1
C=======================================================================SCAL   2
C     PRODUIT SCALAIRE DES VECTEURS X ET Y DE LONGUEUR N                SCAL   3
C       (FONCTION A ECRIRE EVENTUELLEMENT EN ASSEMBLEUR)                SCAL   4
C=======================================================================SCAL   5
      IMPLICIT REAL*8(A-H,O-Z)                                          SCAL   6
      DIMENSION X(1),Y(1)                                               SCAL   7
      DATA ZERO/0.0D0/                                                  SCAL   8
C-----------------------------------------------------------------------SCAL   9
      SCAL=ZERO                                                         SCAL  10
      DO 10 I=1,N                                                       SCAL  11
10    SCAL=SCAL+X(I)*Y(I)                                               SCAL  12
      RETURN                                                            SCAL  13
      END                                                               SCAL  14
C++++++  FIN FIGURE 5.15                                                        
C++++++  DEBUT FIGURE 6.23                                              
      SUBROUTINE BLLIND                                                 BLLD   1
C=======================================================================BLLD   2
C     APPEL DU BLOC 'LIND'                                              BLLD   3
C     ASSEMBLAGE ET RESOLUTION D'UN PROBLEME LINEAIRE AVEC SEGMENTATION BLLD   4
C     DE LA MATRICE KG SUR DISQUE                                       BLLD   5
C=======================================================================BLLD   6
      IMPLICIT REAL*8(A-H,O-Z)                                          BLLD   7
      REAL*4 TBL                                                        BLLD   8
      COMMON/COOR/NDIM,NNT,NDLN,NDLT                                    BLLD   9
      COMMON/ELEM/NUL(4),ME                                             BLLD  10
      COMMON/ASSE/NSYM,NKG,NKE,NDLE                                     BLLD  11
      COMMON/RESO/NEQ,NRES,MRES                                         BLLD  12
      COMMON/LIND/NLBL,NBLM,MKG1,MKG2                                   BLLD  13
      COMMON/ES/M,MR,MP,M1,M2,M3,M4,M5                                  BLLD  14
      COMMON/ALLOC/NVA,IVA,IVAMAX,NREEL                                 BLLD  15
      COMMON/LOC/LCORG,LDLNC,LNEQ,LDIMP,LPRNG,LPREG,LLD,LLOCE,LCORE,LNE,BLLD  16
     1  LPRNE,LPREE,LDLE,LKE,LFE,LKGS,LKGD,LKGI,LFG,LRES,LDLG           BLLD  17
      COMMON VA(1)                                                      BLLD  18
      DIMENSION TBL(10),IN(3)                                           BLLD  19
      DATA TBL/4HKGS ,4HKGD ,4HKGI ,4HFG  ,4HKE  ,4HFE  ,4HRES ,4HDLE , BLLD  20
     1  4HEB  ,4HPB  /,DEUX/2.D0/,NBLMAX/100/                           BLLD  21
C-----------------------------------------------------------------------BLLD  22
C-------  FICHIERS                                                      BLLD  23
      IF(M1.EQ.0) M1=MR                                                 BLLD  24
      IF(M2.EQ.0) M2=ME                                                 BLLD  25
      IF(M3.EQ.0) M3=MRES                                               BLLD  26
      IF(M4.EQ.0) M4=MKG1                                               BLLD  27
      IF(M5.EQ.0) M5=MKG2                                               BLLD  28
C-------  LECTURE DES PARAMETRES DU BLOC                                BLLD  29
      READ(M1,1000) IN                                                  BLLD  30
1000  FORMAT(3I5)                                                       BLLD  31
      IF(IN(1).NE.0) NRES=1                                             BLLD  32
      NLBL=IN(2)                                                        BLLD  33
      NBLM=IN(3)                                                        BLLD  34
      WRITE(MP,2000) M,NRES                                             BLLD  35
2000  FORMAT(//' ASSEMBLAGE-RESOLUTION LINEAIRE SUR DISQUE (M=',I2,')'/ BLLD  36
     1  ' ',42('=')/15X,'INDICE DE CALCUL DU RESIDUS       (NRES)=',I5) BLLD  37
      IF(LKGD.EQ.1) CALL ESPACE(NEQ,1,TBL(2),LKGD)                      BLLD  38
      IF(LFG.EQ.1) CALL ESPACE(NEQ,1,TBL(4),LFG)                        BLLD  39
      IF(LKE.EQ.1) CALL ESPACE(NKE,1,TBL(5),LKE)                        BLLD  40
      IF(LFE.EQ.1) CALL ESPACE(NDLE,1,TBL(6),LFE)                       BLLD  41
      IF(LRES.EQ.1) CALL ESPACE(NDLT,1,TBL(7),LRES)                     BLLD  42
      IF(LDLE.EQ.1) CALL ESPACE(NDLE,1,TBL(8),LDLE)                     BLLD  43
C-------  DETERMINATION DE LA LONGUEUR DES BLOCS                        BLLD  44
      I3=2                                                              BLLD  45
      I2=1+NSYM                                                         BLLD  46
      IF(NLBL.EQ.0) GO TO 10                                            BLLD  47
      IF(NBLM.EQ.0) NBLM=NKG/NLBL+2                                     BLLD  48
      GO TO 30                                                          BLLD  49
10    I1=NVA-IVA-(2*NBLMAX+2)/NREEL-1                                   BLLD  50
      IF(I1.GE.(NKG*I2+2)) GO TO 20                                     BLLD  51
C-------  CAS OU LA MATRICE DOIT ETRE SEGMENTEE                         BLLD  52
      NLBL=I1/(DEUX*I2)                                                 BLLD  53
      NBLM=NKG/NLBL+2                                                   BLLD  54
      GO TO 30                                                          BLLD  55
C-------  CAS OU LA MATRICE TIENT EN MEMOIRE                            BLLD  56
20    NLBL=NKG                                                          BLLD  57
      NBLM=1                                                            BLLD  58
      I3=1                                                              BLLD  59
30    WRITE(MP,2010) NLBL,NBLM                                          BLLD  60
2010  FORMAT(                                                           BLLD  61
     1  15X,'LONGUEUR DES BLOCS DE KG          (NLBL)=',I5/             BLLD  62
     2  15X,'NOMBRE MAX. DE BLOCS DE KG              =',I5)             BLLD  63
      CALL ESPACE(NBLM+1,0,TBL(9),LEB)                                  BLLD  64
      CALL ESPACE(NBLM,0,TBL(10),LPB)                                   BLLD  65
      IF(LKGS.EQ.1) CALL ESPACE(NLBL*I3,1,TBL(1),LKGS)                  BLLD  66
      IF(NSYM.EQ.1.AND.LKGI.EQ.1) CALL ESPACE(NLBL*I3,1,TBL(3),LKGI)    BLLD  67
      CALL EXLIND(VA(LLD),VA(LDIMP),VA(LLOCE),VA(LCORE),VA(LPRNE),      BLLD  68
     1            VA(LPREE),VA(LNE),VA(LKE),VA(LFE),VA(LKGS),VA(LKGD),  BLLD  69
     2            VA(LKGI),VA(LFG),VA(LCORG),VA(LDLNC),VA(LNEQ),        BLLD  70
     3            VA(LRES),VA(LDLE),VA(LEB),VA(LPB))                    BLLD  71
      RETURN                                                            BLLD  72
      END                                                               BLLD  73
                                                                                
      SUBROUTINE EXLIND(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,  EXLD   1
     1       VKGS,VKGD,VKGI,VFG,VCORG,KDLNC,KNEQ,VRES,VDLE,KEB,KPB)     EXLD   2
C=======================================================================EXLD   3
C     EXECUTION DU BLOC 'LIND'                                          EXLD   4
C     ASSEMBLAGE ET RESOLUTION D'UN PROBLEME LINEAIRE AVEC SEGMENTATION EXLD   5
C     DE LA MATRICE KG SUR DISQUE                                       EXLD   6
C=======================================================================EXLD   7
      IMPLICIT REAL*8(A-H,O-Z)                                          EXLD   8
      COMMON/ASSE/NSYM,NKG,NKE,NDLE                                     EXLD   9
      COMMON/RESO/NEQ,NRES,MRES                                         EXLD  10
      COMMON/LIND/NLBL,NBLM,MKG1,MKG2                                   EXLD  11
      COMMON/ES/M,MR,MP,M1,M2,M3                                        EXLD  12
      DIMENSION KLD(1),VDIMP(1),KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),    EXLD  13
     1  KNE(1),VKE(1),VFE(1),VKGS(1),VKGD(1),VKGI(1),VFG(1),VCORG(1),   EXLD  14
     2  KDLNC(1),KNEQ(1),VRES(1),VDLE(1),KEB(1),KPB(1)                  EXLD  15
C-----------------------------------------------------------------------EXLD  16
      REWIND M3                                                         EXLD  17
C-------  CALCUL DES TABLES EB ET PB DEFINISSANT LES BLOCS D'EQUATIONS  EXLD  18
      CALL EQBLOC(KLD,NLBL,NBLM,NEQ,KEB,KPB)                            EXLD  19
      WRITE(MP,2000) NBLM                                               EXLD  20
2000  FORMAT(15X,'NOMBRE DE BLOCS DE KG (NBLM)=',I5)                    EXLD  21
      IF(M.LT.2) GO TO 10                                               EXLD  22
      I1=NBLM+1                                                         EXLD  23
      WRITE(MP,2010) (KEB(I),I=1,I1)                                    EXLD  24
2010  FORMAT(/' PREMIERE EQUATION DE CHAQUE BLOC: (EB)'/(5X,20I5))      EXLD  25
      WRITE(MP,2020) (KPB(I),I=1,NBLM)                                  EXLD  26
2020  FORMAT(/' PREMIER BLOC CONNECTE A CHAQUE BLOC: (PB)'/(5X,20I5))   EXLD  27
C------  SAUVER FG NON MODIFIE PAR LES C.L. IMPOSEES                    EXLD  28
10    WRITE (M3) (VFG(I),I=1,NEQ)                                       EXLD  29
      IF(M.GE.2) WRITE(MP,2030) (VFG(I),I=1,NEQ)                        EXLD  30
2030  FORMAT(/' VECTEUR SOLLICITATIONS GLOBAL NON MODIFIE PAR LES C.L. (EXLD  31
     1FG)'/(1X,10E12.5))                                                EXLD  32
C-------  ASSEMBLER KG,MODIFIER FG POUR LES C.L. ET SAUVER FG MODIFIE   EXLD  33
      CALL ASKGD(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,VKGS,    EXLD  34
     1  VKGD,VKGI,VFG,VDLE,VRES,KEB)                                    EXLD  35
      WRITE(M3) (VFG(I),I=1,NEQ)                                        EXLD  36
C-------  IMPRESSION DE FG                                              EXLD  37
      IF(M.GE.2) WRITE(MP,2040) (VFG(I),I=1,NEQ)                        EXLD  38
2040  FORMAT(/' VECTEUR SOLLICITATIONS GLOBAL MODIFIE PAR LES C.L. (FG)'EXLD  39
     1 /(1X,10E12.5))                                                   EXLD  40
C                                                                       EXLD  41
C-------  RESOLUTION                                                    EXLD  42
C                                                                       EXLD  43
20    CALL SOLD(VKGS,VKGD,VKGI,VFG,KLD,NEQ,MP,1,1,NSYM,ENERG,KEB,KPB)   EXLD  44
      IF(NSYM.NE.1) WRITE(MP,2050) ENERG                                EXLD  45
2050  FORMAT(15X,'ENERGIE    (ENERG)=',1E12.5)                          EXLD  46
C-------  PIVOTS DE KG ET DETERMINANT                                   EXLD  47
30    CALL PRPVTS(VKGD)                                                 EXLD  48
C-------  IMPRESSION DE LA SOLUTION                                     EXLD  49
      WRITE(MP,2060)                                                    EXLD  50
2060  FORMAT(//' SOLUTION'//)                                           EXLD  51
      CALL PRSOL(KDLNC,VCORG,VDIMP,KNEQ,VFG)                            EXLD  52
C                                                                       EXLD  53
C-------  CALCUL ET IMPRESSION DES GRADIENTS                            EXLD  54
C                                                                       EXLD  55
      CALL ASGRAD(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,VKGS,   EXLD  56
     1  VKGD,VKGI,VFG,VDLE,VRES)                                        EXLD  57
C                                                                       EXLD  58
C-------  CALCUL ET IMPRESSION DES RESIDUS D'EQUILIBRE ET REACTIONS     EXLD  59
C                                                                       EXLD  60
C-------  LIRE LE VECTEUR FG ET LE CHANGER DE SIGNE                     EXLD  61
      REWIND M3                                                         EXLD  62
      READ(M3) (VRES(I),I=1,NEQ)                                        EXLD  63
      DO 40 I=1,NEQ                                                     EXLD  64
40    VRES(I)=-VRES(I)                                                  EXLD  65
C-------  ASSEMBLER LES RESIDUS ET LES REACTIONS                        EXLD  66
      CALL ASRESD(1,1,KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,    EXLD  67
     1  VKGS,VKGD,VKGI,VFG,VDLE,VRES,VRES(NEQ+1))                       EXLD  68
C-------  IMPRESSION                                                    EXLD  69
      WRITE(MP,2070)                                                    EXLD  70
2070  FORMAT(//' RESIDUS D EQUILIBRE ET REACTIONS'//)                   EXLD  71
      CALL PRSOL(KDLNC,VCORG,VRES(NEQ+1),KNEQ,VRES)                     EXLD  72
      RETURN                                                            EXLD  73
      END                                                               EXLD  74
                                                                                
      SUBROUTINE EQBLOC(KLD,NLBL,NBLMAX,NEQ,KEB,KPB)                    EQBL   1
C=======================================================================EQBL   2
C     CALCUL DES TABLES KEB ET KPB DEFINISSANT LES BLOCS D'EQUATIONS    EQBL   3
C       ENTREES                                                         EQBL   4
C          KLD     TABLE DES POINTEURS DES HAUTS DE COLONNE DE KG       EQBL   5
C          NLBL    LONGUEUR DES BLOCS                                   EQBL   6
C          NBLMAX  NOMBRE MAX. DE BLOCS ADMISSIBLE                      EQBL   7
C          NEQ     NOMBRE D EQUATIONS                                   EQBL   8
C       SORTIES                                                         EQBL   9
C          KEB     TABLE DES NUMEROS DES PREMIERES EQUATIONS DE CHAQUE  EQBL  10
C                  BLOC (DIMENSION NEQ+1)                               EQBL  11
C          KPB     TABLE DES NUMEROS DES PREMIERS BLOCS CONNECTES A     EQBL  12
C                  CHAQUE BLOC (DIMENSION NEQ)                          EQBL  13
C          NBLMAX  NOMBRE DE BLOCS                                      EQBL  14
C=======================================================================EQBL  15
      COMMON/ES/M,MR,MP                                                 EQBL  16
      DIMENSION KLD(1),KEB(1),KPB(1)                                    EQBL  17
C-----------------------------------------------------------------------EQBL  18
C-------  PREMIER BLOC                                                  EQBL  19
      ILBL=0                                                            EQBL  20
      NBL=1                                                             EQBL  21
      KEB(1)=1                                                          EQBL  22
      KPB(1)=1                                                          EQBL  23
      IMIN=1                                                            EQBL  24
C-------  POUR CHAQUE EQUATION                                          EQBL  25
      DO 70 IK=1,NEQ                                                    EQBL  26
C-------  POINTEURS DE LA COLONNE IK                                    EQBL  27
      JHK=KLD(IK)                                                       EQBL  28
      JHK1=KLD(IK+1)                                                    EQBL  29
      LBK1=JHK1-JHK                                                     EQBL  30
      IF(LBK1.LE.NLBL) GO TO 10                                         EQBL  31
      WRITE(MP,2000) IK,LBK1,NLBL                                       EQBL  32
2000  FORMAT(' *** ERREUR,COLONNE',I5,' PLUS GRANDE(',I5,')QUE LE BLOC('EQBL  33
     1  ,I5,')')                                                        EQBL  34
      STOP                                                              EQBL  35
C-------  TEST POUR UN NOUVEAU BLOC                                     EQBL  36
10    ILBL=ILBL+LBK1                                                    EQBL  37
      IF(ILBL.LE.NLBL) GO TO 60                                         EQBL  38
      NBL=NBL+1                                                         EQBL  39
      IF(NBL.LE.NBLMAX) GO TO 20                                        EQBL  40
      WRITE(MP,2010) IK                                                 EQBL  41
2010  FORMAT(' *** ERREUR,NOMBRE DE BLOCS TROP ELEVE,EQUATION',I5)      EQBL  42
      STOP                                                              EQBL  43
20    KEB(NBL)=IK                                                       EQBL  44
      ILBL=LBK1                                                         EQBL  45
C-------  RECHERCHE DU PREMIER BLOC CONNECTE AU BLOC TERMINE            EQBL  46
      IB=NBL                                                            EQBL  47
40    IF(IMIN.GE.KEB(IB)) GO TO 50                                      EQBL  48
      IB=IB-1                                                           EQBL  49
      GO TO 40                                                          EQBL  50
50    KPB(NBL-1)=IB                                                     EQBL  51
      IMIN=IK                                                           EQBL  52
C-------  RECHERCHE DU NUMERO DE LIGNE MINIMUM DES HAUTS DE COLONNE     EQBL  53
60    I=IK-LBK1+1                                                       EQBL  54
      IF(I.LT.IMIN)IMIN=I                                               EQBL  55
70    CONTINUE                                                          EQBL  56
C-------  PREMIER BLOC CONNECTE AU DERNIER BLOC                         EQBL  57
      IB=NBL                                                            EQBL  58
80    IF(IMIN.GE.KEB(IB)) GO TO 90                                      EQBL  59
      IB=IB-1                                                           EQBL  60
      GO TO 80                                                          EQBL  61
90    KPB(NBL)=IB                                                       EQBL  62
      KEB(NBL+1)=NEQ+1                                                  EQBL  63
      NBLMAX=NBL                                                        EQBL  64
      RETURN                                                            EQBL  65
      END                                                               EQBL  66
                                                                                
      SUBROUTINE ASKGD(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,   ASKD   1
     1  VKGS,VKGD,VKGI,VFG,VDLE,VRES,KEB)                               ASKD   2
C=======================================================================ASKD   3
C     ASSEMBLAGE DE LA MATRICE GLOBALE KG (FONCTION ELEMENTAIRE         ASKD   4
C     DE TYPE 3) AVEC PRISE EN COMPTE DES D.L. IMPOSES NON NULS         ASKD   5
C     VERSION AVEC MATRICE KG SEGMENTEE SUR LE FICHIER M4               ASKD   6
C=======================================================================ASKD   7
      IMPLICIT REAL*8(A-H,O-Z)                                          ASKD   8
      COMMON/COND/NCLT,NCLZ,NCLNZ                                       ASKD   9
      COMMON/ELEM/NELT,NNEL,NTPE,NGRE,ME,NIDENT                         ASKD  10
      COMMON/ASSE/NSYM                                                  ASKD  11
      COMMON/RESO/NEQ                                                   ASKD  12
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGASKD  13
     1  ,ICOD                                                           ASKD  14
      COMMON/LIND/NLBL,NBLM,MKG1,MKG2                                   ASKD  15
      COMMON/ES/M,MR,MP,M1,M2,M3,M4,M5                                  ASKD  16
      DIMENSION KLD(1),VDIMP(1),KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),    ASKD  17
     1  KNE(1),VKE(1),VFE(1),VKGS(1),VKGD(1),VKGI(1),VFG(1),VDLE(1),    ASKD  18
     1  VRES(1),KEB(1)                                                  ASKD  19
      DATA ZERO/0.D0/                                                   ASKD  20
C-----------------------------------------------------------------------ASKD  21
C-------  POSITIONNER AU DEBUT LE FICHIER M4                            ASKD  22
      REWIND M4                                                         ASKD  23
C-------  BOUCLE SUR LES BLOCS                                          ASKD  24
      DO 80 IB=1,NBLM                                                   ASKD  25
C-------  INITIALISER LE BLOC                                           ASKD  26
      DO 10 I=1,NLBL                                                    ASKD  27
      IF(NSYM.EQ.1) VKGI(I)=ZERO                                        ASKD  28
10    VKGS(I)=ZERO                                                      ASKD  29
      IE1=KEB(IB)                                                       ASKD  30
      IE2=KEB(IB+1)-1                                                   ASKD  31
C-------  POSITIONNER AU DEBUT LE FICHIER DES ELEMENTS (M2)             ASKD  32
      REWIND M2                                                         ASKD  33
C-------  BOUCLE SUR LES ELEMENTS                                       ASKD  34
      DO 70 IE=1,NELT                                                   ASKD  35
C-------  LIRE UN ELEMENT                                               ASKD  36
      CALL RDELEM(M2,KLOCE,VCORE,VPRNE,VPREE,KNE)                       ASKD  37
C-------  L'ELEMENT INTERVIENT-IL DANS LE BLOC                          ASKD  38
      DO 20 ID=1,IDLE                                                   ASKD  39
      J=KLOCE(ID)                                                       ASKD  40
      IF(J.LT.IE1.OR.J.GT.IE2) GO TO 20                                 ASKD  41
      GO TO 40                                                          ASKD  42
20    CONTINUE                                                          ASKD  43
30    IF(IB.NE.1.OR.(NCLNZ.EQ.0.AND.IB.EQ.1)) GO TO 70                  ASKD  44
C-------  CALCUL DES FONCTIONS D'INTERPOLATION SI NECESSAIRE            ASKD  45
40    IF(ITPE.EQ.ITPE1) GO TO 50                                        ASKD  46
      ICOD=2                                                            ASKD  47
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASKD  48
C-------  CALCUL DE LA MATRICE ELEMENTAIRE                              ASKD  49
50    ICOD=3                                                            ASKD  50
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASKD  51
C-------  IMPRESSION DE LA MATRICE ELEMENTAIRE                          ASKD  52
      IF(M.LT.2) GO TO 60                                               ASKD  53
      IF(NSYM.EQ.0) IKE=IDLE*(IDLE+1)/2                                 ASKD  54
      IF(NSYM.EQ.1) IKE=IDLE*IDLE                                       ASKD  55
      WRITE(MP,2000) IEL,(VKE(I),I=1,IKE)                               ASKD  56
2000  FORMAT(/' MATRICE (KE) , ELEMENT:',I5/(10X,10E12.5))              ASKD  57
C-------  MODIFICATION DE FG DUE AUX D.L. IMPOSES NON NULS              ASKD  58
60    IF(NCLNZ.NE.0.AND.IB.EQ.1) CALL MODFG(IDLE,NSYM,KLOCE,VDIMP,VKE,  ASKD  59
     1  VFG)                                                            ASKD  60
C-------  ASSEMBLAGE                                                    ASKD  61
      CALL ASSELD(1,0,IDLE,NSYM,IE1,IE2,KLOCE,KLD,VKE,VFE,VKGS,VKGD,    ASKD  62
     1  VKGI,VFG)                                                       ASKD  63
      ITPE1=ITPE                                                        ASKD  64
70    CONTINUE                                                          ASKD  65
C-------  FIN D'UN BLOC                                                 ASKD  66
      WRITE(M4) (VKGS(I),I=1,NLBL)                                      ASKD  67
      IF(NSYM.EQ.1) WRITE(M4) (VKGI(I),I=1,NLBL)                        ASKD  68
      IF(M.LT.2) GO TO 80                                               ASKD  69
      WRITE(MP,2010) IB,(VKGS(I),I=1,NLBL)                              ASKD  70
2010  FORMAT(' BLOC DU TRIANGLE SUPERIEUR DE (KG) NO:',I5/(1X,10E12.5)) ASKD  71
      IF(NSYM.EQ.1) WRITE(MP,2020) IB,(VKGI(I),I=1,NLBL)                ASKD  72
2020  FORMAT(' BLOC DU TRIANGLE INFERIEUR DE (KG) NO:',I5/(1X,10E12.5)) ASKD  73
80    CONTINUE                                                          ASKD  74
      IF(M.GE.2) WRITE(MP,2030) (VKGD(I),I=1,NEQ)                       ASKD  75
2030  FORMAT(' DIAGONALE DE (KG)'/(1X,10E12.5))                         ASKD  76
      RETURN                                                            ASKD  77
      END                                                               ASKD  78
                                                                                
      SUBROUTINE ASSELD(IKG,IFG,IDLE,NSYM,IE1,IE2,KLOCE,KLD,VKE,VFE,    ASSD   1
     1  VKGS,VKGD,VKGI,VFG)                                             ASSD   2
C=======================================================================ASSD   3
C     ASSEMBLAGE D'UNE MATRICE ELEMENTAIRE (SYMETRIQUE OU NON) ET/OU    ASSD   4
C     D'UN VECTEUR ELEMENTAIRE. LA MATRICE EST SEGMENTEE SUR DISQUE     ASSD   5
C       ENTREES                                                         ASSD   6
C          IKG     SI IKG.EQ.1 ASSEMBLAGE DE LA MATRICE ELEMENTAIRE KE  ASSD   7
C          IFG     SI IFG.EQ.1 ASSEMBLAGE DU VECTEUR ELEMENTAIRE FE     ASSD   8
C          IDLE    NOMBRE DE D.L. DE L'ELEMENT                          ASSD   9
C          NSYM    0=PROBLEME SYMETRIQUE, 1=PROBLEME NON SYMETRIQUE     ASSD  10
C          IE1,IE2 PREMIERE ET DERNIERE COLONNE DE KG A ASSEMBLER       ASSD  11
C          KLOCE   VECTEUR DE LOCALISATION DE L'ELEMENT                 ASSD  12
C          KLD     HAUTEURS CUMULEES DE COLONNES DE KG                  ASSD  13
C          VKE     MATRICE ELEMENTAIRE KE(PLEINE OU TRIANGLE SUPERIEUR  ASSD  14
C                  PAR COLONNES DESCENDANTES)                           ASSD  15
C          VFE     VECTEUR ELEMENTAIRE FE                               ASSD  16
C       SORTIES                                                         ASSD  17
C          VKGS,VKGD,VKGI    MATRICE GLOBALE (LIGNE DE CIEL)            ASSD  18
C                  (SYMETRIQUE OU NON)                                  ASSD  19
C          VFG     VECTEUR SOLLICITATIONS GLOBAL                        ASSD  20
C=======================================================================ASSD  21
      IMPLICIT REAL*8(A-H,O-Z)                                          ASSD  22
      DIMENSION KLOCE(1),KLD(1),VKE(1),VFE(1),VKGS(1),VKGD(1),          ASSD  23
     1  VKGI(1),VFG(1)                                                  ASSD  24
C-----------------------------------------------------------------------ASSD  25
C                                                                       ASSD  26
C-------  ASSEMBLAGE DE LA MATRICE ELEMENTAIRE                          ASSD  27
C                                                                       ASSD  28
      IF(IKG.NE.1) GO TO 100                                            ASSD  29
      I0BLOC=KLD(IE1)-1                                                 ASSD  30
      IEQ0=IDLE                                                         ASSD  31
      IEQ1=1                                                            ASSD  32
C-------  POUR CHAQUE COLONNE DE KE                                     ASSD  33
      DO 90 JD=1,IDLE                                                   ASSD  34
      IF(NSYM.NE.1) IEQ0=JD                                             ASSD  35
      JL=KLOCE(JD)                                                      ASSD  36
      IF(JL) 90,90,10                                                   ASSD  37
10    I0=KLD(JL+1)-I0BLOC                                               ASSD  38
      IEQ=IEQ1                                                          ASSD  39
      IQ=1                                                              ASSD  40
      IF(JL.LT.IE1.OR.JL.GT.IE2) GO TO 90                               ASSD  41
C-------  POUR CHAQUE LIGNE DE KE                                       ASSD  42
      DO 80 ID=1,IDLE                                                   ASSD  43
      IL=KLOCE(ID)                                                      ASSD  44
      IF(NSYM.EQ.1) GO TO 30                                            ASSD  45
      IF(ID-JD) 30,20,20                                                ASSD  46
20    IQ=ID                                                             ASSD  47
30    IF(IL) 80,80,40                                                   ASSD  48
40    IJ=JL-IL                                                          ASSD  49
      IF(IJ) 80,50,60                                                   ASSD  50
C-------  TERMES DIAGONAUX DE KG                                        ASSD  51
50    VKGD(IL)=VKGD(IL)+VKE(IEQ)                                        ASSD  52
      GO TO 80                                                          ASSD  53
C-------  TERMES DU TRIANGLE SUPERIEUR DE KG                            ASSD  54
60    I=I0-IJ                                                           ASSD  55
      VKGS(I)=VKGS(I)+VKE(IEQ)                                          ASSD  56
      IF(NSYM.NE.1) GO TO 80                                            ASSD  57
C-------  TERMES DU TRIANGLE INFERIEUR DE KG                            ASSD  58
      IEQI=(ID-1)*IDLE+JD                                               ASSD  59
      VKGI(I)=VKGI(I)+VKE(IEQI)                                         ASSD  60
80    IEQ=IEQ+IQ                                                        ASSD  61
90    IEQ1=IEQ1+IEQ0                                                    ASSD  62
C                                                                       ASSD  63
C-------  ASSEMBLAGE DU VECTEUR ELEMENTAIRE                             ASSD  64
C                                                                       ASSD  65
100   IF(IFG.NE.1) GO TO 130                                            ASSD  66
      DO 120 ID=1,IDLE                                                  ASSD  67
      IL=KLOCE(ID)                                                      ASSD  68
      IF(IL) 120,120,110                                                ASSD  69
110   VFG(IL)=VFG(IL)+VFE(ID)                                           ASSD  70
120   CONTINUE                                                          ASSD  71
130   RETURN                                                            ASSD  72
      END                                                               ASSD  73
C++++++  FIN FIGURE 6.23                                                        
C++++++  DEBUT FIGURE 5.16                                                      
      SUBROUTINE SOLD(VKGS,VKGD,VKGI,VFG,KLD,NEQ,MP,IFAC,ISOL,NSYM,ENERGSOLD   1
     1  ,KEB,KPB)                                                       SOLD   2
C=======================================================================SOLD   3
C     RESOLUTION D'UN SYSTEME LINEAIRE SYMETRIQUE OU NON. LA MATRICE    SOLD   4
C     EST STOCKEE PAR LIGNE DE CIEL SUR LE FICHIER M4. APRES TRIANGULA- SOLD   5
C     RISATION ELLE EST PLACEE SUR LE FICHIER M5                        SOLD   6
C       ENTREES                                                         SOLD   7
C          VKGS,VKGD,VKGI    MATRICE DU SYSTEME : PARTIES SUPERIEURE,   SOLD   8
C                            DIAGONALE, INFERIEURE                      SOLD   9
C          VFG               SECOND MEMBRE                              SOLD  10
C          KLD               POINTEURS VERS LES HAUTS DE COLONNE        SOLD  11
C          NEQ               NOMBRE D'EQUATIONS                         SOLD  12
C          MP                UNITE LOGIQUE D'IMPRESSION                 SOLD  13
C          IFAC              SI IFAC.EQ.1 TRIANGULARISATION DE          SOLD  14
C                            LA MATRICE                                 SOLD  15
C          ISOL              SI ISOL.EQ.1 CALCUL DE LA SOLUTION A       SOLD  16
C                            PARTIR DE LA MATRICE TRIANGULARISEE        SOLD  17
C          NSYM              INDICE DE PROBLEME NON SYMETRIQUE          SOLD  18
C          KEB               NUMERO DE LA PREMIERE EQUATION DE CHAQUE   SOLD  19
C                            BLOC                                       SOLD  20
C          KPB               NUMERO DU PREMIER BLOC CONNECTE A CHAQUE   SOLD  21
C                            BLOC                                       SOLD  22
C       SORTIES                                                         SOLD  23
C          VKGS,VKGD,VKGI    MATRICE TRIANGULARISEE (SI IFAC.EQ.1)      SOLD  24
C          VFG               SOLUTION (SI ISOL.EQ.1)                    SOLD  25
C          ENERG             ENERGIE DU SYSTEME (SI NSYM.EQ.0)          SOLD  26
C=======================================================================SOLD  27
      IMPLICIT REAL*8 (A-H,O-Z)                                         SOLD  28
      COMMON/LIND/NLBL,NBLM                                             SOLD  29
      COMMON/ES/M,MR,MP1,M1,M2,M3,M4,M5                                 SOLD  30
      DIMENSION VKGS(1),VKGD(1),VKGI(1),VFG(1),KLD(1),KEB(1),KPB(1)     SOLD  31
      DATA ZERO/0.0D0/                                                  SOLD  32
C-----------------------------------------------------------------------SOLD  33
      REWIND M4                                                         SOLD  34
      REWIND M5                                                         SOLD  35
      IK=1                                                              SOLD  36
      IF(VKGD(1).NE.ZERO) GO TO 5                                       SOLD  37
      WRITE(MP,2000) IK                                                 SOLD  38
      STOP                                                              SOLD  39
5     ENERG=ZERO                                                        SOLD  40
C                                                                       SOLD  41
C-------  POUR CHAQUE BLOC A TRIANGULARISER                             SOLD  42
C                                                                       SOLD  43
      J1MIN=NLBL+1                                                      SOLD  44
      J1MAX=NLBL+NLBL                                                   SOLD  45
      DO 105 IB=1,NBLM                                                  SOLD  46
C-------  LIRE UN BLOC A TRIANGULARISER                                 SOLD  47
      READ(M4) (VKGS(I),I=1,NLBL)                                       SOLD  48
      IF(NSYM.EQ.1) READ(M4) (VKGI(I),I=1,NLBL)                         SOLD  49
C-------  PARAMETRES DU BLOC IB                                         SOLD  50
      IK0=KEB(IB)                                                       SOLD  51
      IK1=KEB(IB+1)-1                                                   SOLD  52
      IB0=KPB(IB)                                                       SOLD  53
      J0=KLD(IK0)-1                                                     SOLD  54
      IF(IB0.EQ.IB) GO TO 11                                            SOLD  55
C-------  BACKSPACE SUR LES BLOCS CONNECTES                             SOLD  56
      I1=IB-IB0                                                         SOLD  57
      DO 10 I=1,I1                                                      SOLD  58
      BACKSPACE M5                                                      SOLD  59
      IF(NSYM.EQ.1) BACKSPACE M5                                        SOLD  60
10    CONTINUE                                                          SOLD  61
C-------  POUR CHAQUE BLOC CONNECTE(INCLUANT LE BLOC IB LUI-MEME)       SOLD  62
11    DO 103 IBC=IB0,IB                                                 SOLD  63
      IF(IBC.EQ.IB) GO TO 12                                            SOLD  64
      READ(M5) (VKGS(I),I=J1MIN,J1MAX)                                  SOLD  65
      IF(NSYM.EQ.1) READ(M5) (VKGI(I),I=J1MIN,J1MAX)                    SOLD  66
C-------  PARAMETRES DU BLOC CONNECTE                                   SOLD  67
12    II0=KEB(IBC)                                                      SOLD  68
      II1=KEB(IBC+1)-1                                                  SOLD  69
      JC0=KLD(II0)-1                                                    SOLD  70
      IF(IBC.NE.IB) JC0=JC0-NLBL                                        SOLD  71
C                                                                       SOLD  72
C-------  POUR CHAQUE COLONNE DU BLOC IB A MODIFIER                     SOLD  73
C                                                                       SOLD  74
      DO 100 IK=IK0,IK1                                                 SOLD  75
      JHK=KLD(IK)-J0                                                    SOLD  76
C-----  POINTEUR DU HAUT DE LA COLONNE SUIVANTE IK+1                    SOLD  77
      JHK1=KLD(IK+1)-J0                                                 SOLD  78
C-----  HAUTEUR DE LA COLONNE IK (HORS TERMES SUPERIEUR ET DIAGONAL)    SOLD  79
      LHK=JHK1-JHK                                                      SOLD  80
      LHK1=LHK-1                                                        SOLD  81
C-----  LIGNE DU PREMIER TERME A MODIFIER DANS LA COLONNE IK            SOLD  82
      IMIN=IK-LHK1                                                      SOLD  83
      IMIN1=IMIN-1                                                      SOLD  84
C-------  LIGNE DU DERNIER TERME A MODIFIER DANS LA COLONNE IK          SOLD  85
      IMAX=IK-1                                                         SOLD  86
      IF(LHK1.LT.0) GO TO 100                                           SOLD  87
      IF(IFAC.NE.1) GO TO 90                                            SOLD  88
      IF(NSYM.EQ.0) GO TO 14                                            SOLD  89
      IB1=IB                                                            SOLD  90
      IF(IMIN1.LT.IK0) IB1=IB0                                          SOLD  91
      IF(IBC.EQ.IB1) VKGI(JHK)=VKGI(JHK)/VKGD(IMIN1)                    SOLD  92
14    IF(IBC.EQ.IB.AND.IK.EQ.IK0) GO TO 40                              SOLD  93
      IF(LHK1.EQ.0) GO TO 40                                            SOLD  94
C-------  TROUVER LA PREMIERE ET LA DERNIERE LIGNE DE LA COLONNE IK     SOLD  95
C         INFLUENCEE PAR LE BLOC CONNECTE IBC                           SOLD  96
      IMINC=MAX0(IMIN,II0)                                              SOLD  97
      IMAXC=MIN0(IMAX,II1)                                              SOLD  98
      IF(IMINC.GT.IMAXC) GO TO 40                                       SOLD  99
C                                                                       SOLD 100
C-----  MODIFIER LES TERMES NON DIAGONAUX DE LA COLONNE IK              SOLD 101
C                                                                       SOLD 102
      JCK=JHK+IMINC-IMIN1                                               SOLD 103
      JHJ=KLD(IMINC)-JC0                                                SOLD 104
C-------  POUR CHAQUE TERME A MODIFIER PLACE EN JCK                     SOLD 105
      DO 30 IJ=IMINC,IMAXC                                              SOLD 106
      JHJ1=KLD(IJ+1)-JC0                                                SOLD 107
C-----  NOMBRE DE TERMES MODIFICATIFS DU TERME PLACE EN JCK             SOLD 108
      IC=MIN0(JCK-JHK,JHJ1-JHJ)                                         SOLD 109
      IF(IC.LE.0.AND.NSYM.EQ.0) GO TO 20                                SOLD 110
      C1=ZERO                                                           SOLD 111
      IF(IC.LE.0) GO TO 17                                              SOLD 112
      J1=JHJ1-IC                                                        SOLD 113
      J2=JCK-IC                                                         SOLD 114
      IF(NSYM.EQ.1) GO TO 15                                            SOLD 115
      VKGS(JCK)=VKGS(JCK)-SCAL(VKGS(J1),VKGS(J2),IC)                    SOLD 116
      GO TO 20                                                          SOLD 117
15    VKGS(JCK)=VKGS(JCK)-SCAL(VKGI(J1),VKGS(J2),IC)                    SOLD 118
      C1=SCAL(VKGS(J1),VKGI(J2),IC)                                     SOLD 119
17    VKGI(JCK)=(VKGI(JCK)-C1)/VKGD(IJ)                                 SOLD 120
20    JCK=JCK+1                                                         SOLD 121
30    JHJ=JHJ1                                                          SOLD 122
C                                                                       SOLD 123
C-----  MODIFIER LE TERME DIAGONAL                                      SOLD 124
C                                                                       SOLD 125
40    IF(IBC.NE.IB) GO TO 90                                            SOLD 126
      JCK=JHK                                                           SOLD 127
      CDIAG=ZERO                                                        SOLD 128
      DO 70 IJ=IMIN1,IMAX                                               SOLD 129
      C1=VKGS(JCK)                                                      SOLD 130
      IF(NSYM.EQ.1) GO TO 50                                            SOLD 131
      C2=C1/VKGD(IJ)                                                    SOLD 132
      VKGS(JCK)=C2                                                      SOLD 133
      GO TO 60                                                          SOLD 134
50    C2=VKGI(JCK)                                                      SOLD 135
60    CDIAG=CDIAG+C1*C2                                                 SOLD 136
70    JCK=JCK+1                                                         SOLD 137
      VKGD(IK)=VKGD(IK)-CDIAG                                           SOLD 138
      IF(VKGD(IK)) 90,80,90                                             SOLD 139
80    WRITE(MP,2000) IK                                                 SOLD 140
2000  FORMAT(' *** ERREUR,PIVOT NUL EQUATION ',I5)                      SOLD 141
      STOP                                                              SOLD 142
C                                                                       SOLD 143
C-----  RESOLUTION DU SYSTEME TRIANGULAIRE INFERIEUR                    SOLD 144
C                                                                       SOLD 145
   90 IF(ISOL.NE.1) GO TO 100                                           SOLD 146
      IF(IBC.NE.IB) GO TO 100                                           SOLD 147
      IF(NSYM.NE.1) VFG(IK)=VFG(IK)-SCAL(VKGS(JHK),VFG(IMIN1),LHK)      SOLD 148
      IF(NSYM.EQ.1) VFG(IK)=VFG(IK)-SCAL(VKGI(JHK),VFG(IMIN1),LHK)      SOLD 149
100   CONTINUE                                                          SOLD 150
C-------  PROCHAIN BLOC CONNECTE                                        SOLD 151
103   CONTINUE                                                          SOLD 152
C-------  FIN DE L'ELIMINATION DU BLOC                                  SOLD 153
      IF(IB.EQ.NBLM) GO TO 105                                          SOLD 154
      WRITE(M5) (VKGS(I),I=1,NLBL)                                      SOLD 155
      IF(NSYM.EQ.1)  WRITE(M5) (VKGI(I),I=1,NLBL)                       SOLD 156
105   CONTINUE                                                          SOLD 157
      IF(ISOL.NE.1) RETURN                                              SOLD 158
C                                                                       SOLD 159
C-----  RESOLUTION DU SYSTEME DIAGONAL                                  SOLD 160
C                                                                       SOLD 161
      IF(NSYM.EQ.1) GO TO 120                                           SOLD 162
      DO 110 IK=1,NEQ                                                   SOLD 163
      C1=VKGD(IK)                                                       SOLD 164
      C2=VFG(IK)/C1                                                     SOLD 165
      VFG(IK)=C2                                                        SOLD 166
110   ENERG=ENERG+C1*C2*C2                                              SOLD 167
C                                                                       SOLD 168
C-----  RESOLUTION DU SYSTEME TRIANGULAIRE SUPERIEUR                    SOLD 169
C                                                                       SOLD 170
120   IB=NBLM                                                           SOLD 171
      IK0=KEB(IB)-1                                                     SOLD 172
      J0=KLD(IK0+1)-1                                                   SOLD 173
      IK=NEQ+1                                                          SOLD 174
      JHK1=KLD(IK)-J0                                                   SOLD 175
C-------  POUR CHAQUE EQUATION DE NEQ A 1                               SOLD 176
130   IK=IK-1                                                           SOLD 177
C-------  LIRE UN BLOC SI NECESSAIRE                                    SOLD 178
      IF(IK.NE.IK0) GO TO 135                                           SOLD 179
      BACKSPACE M5                                                      SOLD 180
      IF(NSYM.EQ.1) BACKSPACE M5                                        SOLD 181
      READ(M5) (VKGS(I),I=1,NLBL)                                       SOLD 182
      IF(NSYM.EQ.1) READ(M5) (VKGI(I),I=1,NLBL)                         SOLD 183
      BACKSPACE M5                                                      SOLD 184
      IF(NSYM.EQ.1) BACKSPACE M5                                        SOLD 185
      IB=IB-1                                                           SOLD 186
      IK0=KEB(IB)-1                                                     SOLD 187
      J0=KLD(IK0+1)-1                                                   SOLD 188
      JHK1=KLD(IK+1)-J0                                                 SOLD 189
C-------  MODIFIER LE VECTEUR DES INCONNUES                             SOLD 190
135   IF(NSYM.EQ.1) VFG(IK)=VFG(IK)/VKGD(IK)                            SOLD 191
      IF(IK.EQ.1) RETURN                                                SOLD 192
      C1=VFG(IK)                                                        SOLD 193
      JHK=KLD(IK)-J0                                                    SOLD 194
      JBK=JHK1-1                                                        SOLD 195
      IF(JHK.GT.JBK)GO TO 150                                           SOLD 196
      IJ=IK-JBK+JHK-1                                                   SOLD 197
      DO 140 JCK=JHK,JBK                                                SOLD 198
      VFG(IJ)=VFG(IJ)-VKGS(JCK)*C1                                      SOLD 199
140   IJ=IJ+1                                                           SOLD 200
150   JHK1=JHK                                                          SOLD 201
      GO TO 130                                                         SOLD 202
      END                                                               SOLD 203
C++++++  FIN FIGURE 5.16                                                        
C++++++  DEBUT FIGURE 6.24                                                      
      SUBROUTINE BLNLIN                                                 BLNL   1
C=======================================================================BLNL   2
C     APPEL DU BLOC 'NLIN'                                              BLNL   3
C     RESOLUTION D'UN PROBLEME STATIONNAIRE NON LINEAIRE                BLNL   4
C=======================================================================BLNL   5
      IMPLICIT REAL*8(A-H,O-Z)                                          BLNL   6
      REAL*4 TBL                                                        BLNL   7
      COMMON/ELEM/NUL(4),ME                                             BLNL   8
      COMMON/ASSE/NSYM,NKG,NKE,NDLE                                     BLNL   9
      COMMON/RESO/NEQ                                                   BLNL  10
      COMMON/NLIN/EPSDL,XNORM,OMEGA,XPAS,DPAS,DPAS0,NPAS,IPAS,NITER,    BLNL  11
     1  ITER,IMETH                                                      BLNL  12
      COMMON/ES/M,MR,MP,M1,M2,M3,M4                                     BLNL  13
      COMMON/LOC/LCORG,LDLNC,LNEQ,LDIMP,LPRNG,LPREG,LLD,LLOCE,LCORE,LNE,BLNL  14
     1  LPRNE,LPREE,LDLE,LKE,LFE,LKGS,LKGD,LKGI,LFG,LRES,LDLG,LME       BLNL  15
      COMMON VA(1)                                                      BLNL  16
      DIMENSION TBL(10),IN(2),XIN(3)                                    BLNL  17
      DATA TBL/4HKGS ,4HKGD ,4HKGI ,4HFG  ,4HKE  ,                      BLNL  18
     1  4HFE  ,4HRES ,4HDLE ,4HDLG ,4HME  /                             BLNL  19
C-----------------------------------------------------------------------BLNL  20
      IF(M1.EQ.0) M1=MR                                                 BLNL  21
      IF(M2.EQ.0) M2=ME                                                 BLNL  22
      WRITE(MP,2000) M                                                  BLNL  23
2000  FORMAT(//' RESOLUTION NON LINEAIRE (M=',I2,')'/1X,23('='))        BLNL  24
C-------  ALLOCATION D'ESPACE                                           BLNL  25
      IF(LKGS.EQ.1) CALL ESPACE(NKG,1,TBL(1),LKGS)                      BLNL  26
      IF(LKGD.EQ.1) CALL ESPACE(NEQ,1,TBL(2),LKGD)                      BLNL  27
      IF(NSYM.EQ.1.AND.LKGI.EQ.1) CALL ESPACE(NKG,1,TBL(3),LKGI)        BLNL  28
      IF(LFG.EQ.1) CALL ESPACE (NEQ,1,TBL(4),LFG)                       BLNL  29
      IF(LKE.EQ.1) CALL ESPACE(NKE,1,TBL(5),LKE)                        BLNL  30
      IF(LFE.EQ.1) CALL ESPACE(NDLE,1,TBL(6),LFE)                       BLNL  31
      IF(LRES.EQ.1) CALL ESPACE(NEQ,1,TBL(7),LRES)                      BLNL  32
      IF(LDLE.EQ.1) CALL ESPACE(NDLE,1,TBL(8),LDLE)                     BLNL  33
      IF(LDLG.EQ.1) CALL ESPACE(NEQ,1,TBL(9),LDLG)                      BLNL  34
      IF(LME.EQ.1) CALL ESPACE(NKE,1,TBL(10),LME)                       BLNL  35
C-------  EXECUTION DU BLOC                                             BLNL  36
      CALL EXNLIN(VA(LCORG),VA(LDLNC),VA(LDIMP),VA(LNEQ),VA(LLD),       BLNL  37
     1  VA(LLOCE),VA(LCORE),VA(LPRNE),VA(LPREE),VA(LNE),VA(LKE),VA(LME),BLNL  38
     2  VA(LFE),VA(LDLE),VA(LKGS),VA(LKGD),VA(LKGI),VA(LFG),VA(LRES),   BLNL  39
     3  VA(LDLG))                                                       BLNL  40
      RETURN                                                            BLNL  41
      END                                                               BLNL  42
                                                                                
      SUBROUTINE EXNLIN(VCORG,KDLNC,VDIMP,KNEQ,KLD,KLOCE,VCORE,VPRNE,   EXNL   1
     1  VPREE,KNE,VKE,VME,VFE,VDLE,VKGS,VKGD,VKGI,VFG,VRES,VDLG)        EXNL   2
C=======================================================================EXNL   3
C     EXECUTION DU BLOC 'NLIN'                                          EXNL   4
C     RESOLUTION D'UN PROBLEME STATIONNAIRE NON LINEAIRE                EXNL   5
C=======================================================================EXNL   6
      IMPLICIT REAL*8(A-H,O-Z)                                          EXNL   7
      COMMON/RESO/NEQ                                                   EXNL   8
      COMMON/COND/NCLT,NCLZ,NCLNZ                                       EXNL   9
      COMMON/ASSE/NSYM                                                  EXNL  10
      COMMON/NLIN/EPSDL,XNORM,OMEGA,XPAS,DPAS,DPAS0,NPAS,IPAS,NITER,    EXNL  11
     1  ITER,IMETH                                                      EXNL  12
      COMMON/ES/M,MR,MP,M1,M2,M3,M4                                     EXNL  13
      DIMENSION VCORG(1),KDLNC(1),VDIMP(1),KNEQ(1),KLD(1),KLOCE(1),     EXNL  14
     1  VCORE(1),VPRNE(1),VPREE(1),KNE(1),VKE(1),VME(1),VFE(1),VDLE(1), EXNL  15
     2  VKGS(1),VKGD(1),VKGI(1),VFG(1),VRES(1),VDLG(1)                  EXNL  16
      DATA ZERO/0.D0/                                                   EXNL  17
C-----------------------------------------------------------------------EXNL  18
      DPAS0=ZERO                                                        EXNL  19
      XPAS=ZERO                                                         EXNL  20
      IPAS=0                                                            EXNL  21
C-------  LECTURE DES DEGRES DE LIBERTE INITIAUX SUR LE FICHIER M3      EXNL  22
      IF(M3.EQ.0) GO TO 10                                              EXNL  23
      REWIND M3                                                         EXNL  24
      READ(M3) (VDLG(I),I=1,NEQ)                                        EXNL  25
C-------  LIRE UNE CARTE DEFINISSANT UN ENSEMBLE DE PAS IDENTIQUES      EXNL  26
10    READ(M1,1000) DPAS,I1,I2,I3,X1,X2                                 EXNL  27
1000  FORMAT(F10.0,3I5,2F10.0)                                          EXNL  28
      IF(DPAS.EQ.ZERO) GO TO 140                                        EXNL  29
      IF(I1.GT.0) NPAS=I1                                               EXNL  30
      IF(I2.GT.0) NITER=I2                                              EXNL  31
      IF(I3.GT.0) IMETH=I3                                              EXNL  32
      IF(X1.GT.ZERO) EPSDL=X1                                           EXNL  33
      IF(X2.GT.ZERO) OMEGA=X2                                           EXNL  34
C                                                                       EXNL  35
C-------  BOUCLE SUR LES PAS                                            EXNL  36
C                                                                       EXNL  37
      DO 130 IP=1,NPAS                                                  EXNL  38
      IPAS=IPAS+1                                                       EXNL  39
      XPAS=XPAS+DPAS                                                    EXNL  40
      WRITE(MP,2000) IPAS,DPAS,XPAS,NITER,IMETH,EPSDL,OMEGA             EXNL  41
2000  FORMAT(/1X,13('-'),'PAS NUMERO (IPAS):',I5//                      EXNL  42
     1               14X,'ACCROISSEMENT              (DPAS)=',E12.5/    EXNL  43
     2               14X,'NIVEAU TOTAL               (XPAS)=',E12.5/    EXNL  44
     3               14X,'NOMBRE D ITERATIONS       (NITER)=',I12/      EXNL  45
     4               14X,'METHODE NUMERO            (IMETH):',I12/      EXNL  46
     5               14X,'PRECISION                 (EPSDL)=',E12.5/    EXNL  47
     6               14X,'FACTEUR DE SUR-RELAXATION (OMEGA)=',E12.5/)   EXNL  48
C                                                                       EXNL  49
C-------  BOUCLE SUR LES ITERATIONS D'EQUILIBRE                         EXNL  50
C                                                                       EXNL  51
      DO 110 ITER=1,NITER                                               EXNL  52
C-------  CHOIX DE LA METHODE                                           EXNL  53
      IF(IMETH.GT.3) GO TO 20                                           EXNL  54
C-------  METHODES DE TYPE NEWTON                                       EXNL  55
      CALL NEWTON(VCORG,KDLNC,VDIMP,KNEQ,KLD,KLOCE,VCORE,VPRNE,VPREE,   EXNL  56
     1  KNE,VKE,VME,VFE,VDLE,VKGS,VKGD,VKGI,VFG,VRES,VDLG)              EXNL  57
      GO TO 100                                                         EXNL  58
C-------  AUTRES METHODES ......                                        EXNL  59
20    CONTINUE                                                          EXNL  60
      WRITE(MP,2010) IMETH                                              EXNL  61
2010  FORMAT(' ** ERREUR, METHODE:',I3,' INCONNUE')                     EXNL  62
      STOP                                                              EXNL  63
C-------  CALCUL DE LA NORME                                            EXNL  64
100   CALL NORME(NEQ,VRES,VDLG,XNORM)                                   EXNL  65
      IF(M.GT.0) WRITE(MP,2020) ITER,XNORM                              EXNL  66
2020  FORMAT(5X,'ITERATION (ITER):',I3,' NORME (XNORM)=',E12.5)         EXNL  67
      IF(M.GE.2) CALL PRSOL(KDLNC,VCORG,VDIMP,KNEQ,VDLG)                EXNL  68
      IF(XNORM.LE.EPSDL) GO TO 120                                      EXNL  69
110   CONTINUE                                                          EXNL  70
      ITER=NITER                                                        EXNL  71
C-------  FIN DU PAS                                                    EXNL  72
120   DPAS0=DPAS                                                        EXNL  73
      WRITE(MP,2030) ITER,NITER                                         EXNL  74
2030  FORMAT(/10X,I4,' ITERATIONS EFFECTUEES SUR',I4/)                  EXNL  75
      IF(M.LT.2) CALL PRSOL(KDLNC,VCORG,VDIMP,KNEQ,VDLG)                EXNL  76
130   CONTINUE                                                          EXNL  77
      GO TO 10                                                          EXNL  78
C-------  SAUVEGARDE DE LA SOLUTION SUR FICHIER M4                      EXNL  79
140   IF(M4.NE.0) WRITE(M4) (VDLG(I),I=1,NEQ)                           EXNL  80
      RETURN                                                            EXNL  81
      END                                                               EXNL  82
                                                                                
      SUBROUTINE NEWTON(VCORG,KDLNC,VDIMP,KNEQ,KLD,KLOCE,VCORE,VPRNE,   NEWT   1
     1  VPREE,KNE,VKE,VME,VFE,VDLE,VKGS,VKGD,VKGI,VFG,VRES,VDLG)        NEWT   2
C=======================================================================NEWT   3
C     ALGORITHME DES METHODES DE TYPE NEWTON-RAPHSON                    NEWT   4
C       IMETH.EQ.1  CALCUL DE K A CHAQUE ITERATION                      NEWT   5
C       IMETH.EQ.2  K CONSTANTE                                         NEWT   6
C       IMETH.EQ.3  K RECALCULEE AU DEBUT DE CHAQUE PAS                 NEWT   7
C=======================================================================NEWT   8
      IMPLICIT REAL*8(A-H,O-Z)                                          NEWT   9
      COMMON/ASSE/NSYM,NKG                                              NEWT  10
      COMMON/RESO/NEQ                                                   NEWT  11
      COMMON/NLIN/EPSDL,XNORM,OMEGA,XPAS,DPAS,DPAS0,NPAS,IPAS,NITER,    NEWT  12
     1  ITER,IMETH                                                      NEWT  13
      COMMON/ES/M,MR,MP                                                 NEWT  14
      DIMENSION VCORG(1),KDLNC(1),VDIMP(1),KNEQ(1),KLD(1),KLOCE(1),     NEWT  15
     1  VCORE(1),VPRNE(1),VPREE(1),KNE(1),VKE(1),VME(1),VFE(1),VDLE(1), NEWT  16
     2  VKGS(1),VKGD(1),VKGI(1),VFG(1),VRES(1),VDLG(1)                  NEWT  17
      DATA ZERO/0.D0/,UN/1.D0/                                          NEWT  18
C-----------------------------------------------------------------------NEWT  19
C-------  DECISION DE REASSEMBLAGE DE LA MATRICE GLOBALE                NEWT  20
      IKT=0                                                             NEWT  21
      IF(IMETH.EQ.1) GO TO 10                                           NEWT  22
      IF(IPAS.EQ.1.AND.ITER.EQ.1) GO TO 10                              NEWT  23
      IF(IMETH.EQ.3.AND.ITER.EQ.1) GO TO 10                             NEWT  24
      GO TO 20                                                          NEWT  25
10    IKT=1                                                             NEWT  26
C-------  INITIALISER A ZERO LA MATRICE GLOBALE SI ON DOIT L'ASSEMBLER  NEWT  27
20    IF(IKT.EQ.0)GO TO 30                                              NEWT  28
      CALL INIT(ZERO,NKG,VKGS)                                          NEWT  29
      CALL INIT(ZERO,NEQ,VKGD)                                          NEWT  30
      IF(NSYM.EQ.1) CALL INIT(ZERO,NKG,VKGI)                            NEWT  31
C-------  PLACER LES SOLLICITATIONS DANS LE RESIDU                      NEWT  32
30    CALL MAJ(XPAS,ZERO,NEQ,VFG,VRES)                                  NEWT  33
C-------  ASSEMBLER LE RESIDU ET,EVENTUELLEMENT LA MATRICE GLOBALE      NEWT  34
      CALL ASNEWT(IKT,KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,    NEWT  35
     1  VKGS,VKGD,VKGI,VDLG,VDLE,VRES)                                  NEWT  36
C-------  RESOLUTION                                                    NEWT  37
      CALL SOL(VKGS,VKGD,VKGI,VRES,KLD,NEQ,MP,IKT,1,NSYM,ENERG)         NEWT  38
      IF(IKT.EQ.1.AND.M.GT.1) CALL PRPVTS(VKGD)                         NEWT  39
C-------  MISE A JOUR DE LA SOLUTION                                    NEWT  40
      CALL MAJ(OMEGA,UN,NEQ,VRES,VDLG)                                  NEWT  41
      RETURN                                                            NEWT  42
      END                                                               NEWT  43
                                                                                
      SUBROUTINE ASNEWT(IKT,KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,          ASNE   1
     1  KNE,VKE,VFE,VKGS,VKGD,VKGI,VFG,VDLE,VRES)                       ASNE   2
C=======================================================================ASNE   3
C     ASSEMBLAGE DES RESIDUS ET DE LA MATRICE GLOBALE (SI IKT.EQ.1)     ASNE   4
C     DANS LA MEME BOUCLE SUR LES ELEMENTS (POUR LA METHODE DE NEWTON-  ASNE   5
C     RAPHSON)                                                          ASNE   6
C=======================================================================ASNE   7
      IMPLICIT REAL*8(A-H,O-Z)                                          ASNE   8
      COMMON/ELEM/NELT,NNEL,NTPE,NGRE,ME,NIDENT                         ASNE   9
      COMMON/ASSE/NSYM                                                  ASNE  10
      COMMON/RESO/NEQ                                                   ASNE  11
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGASNE  12
     1  ,ICOD                                                           ASNE  13
      COMMON/ES/M,MR,MP,M1,M2                                           ASNE  14
      DIMENSION KLD(1),VDIMP(1),KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),    ASNE  15
     1  KNE(1),VKE(1),VFE(1),VKGS(1),VKGD(1),VKGI(1),VFG(1),VDLE(1),    ASNE  16
     2  VRES(1)                                                         ASNE  17
C-----------------------------------------------------------------------ASNE  18
C-------  POSITIONNER AU DEBUT LE FICHIER DES ELEMENTS (M2)             ASNE  19
      REWIND M2                                                         ASNE  20
C-------  BOUCLE SUR LES ELEMENTS                                       ASNE  21
      DO 40 IE=1,NELT                                                   ASNE  22
C-------  LIRE UN ELEMENT                                               ASNE  23
      CALL RDELEM(M2,KLOCE,VCORE,VPRNE,VPREE,KNE)                       ASNE  24
C-------  CALCUL DES FONCTIONS D'INTERPOLATION SI NECESSAIRE            ASNE  25
      IF(ITPE.EQ.ITPE1) GO TO 10                                        ASNE  26
      ICOD=2                                                            ASNE  27
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASNE  28
C-------  EXTRAIRE LES D.L. DE L'ELEMENT DE VFG                         ASNE  29
10    CALL DLELM(KLOCE,VFG,VDIMP,VDLE)                                  ASNE  30
C-------  CALCULER LES RESIDUS ELEMENTAIRES ET CHANGER LEURS SIGNES     ASNE  31
      ICOD=6                                                            ASNE  32
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASNE  33
      DO 20 I=1,IDLE                                                    ASNE  34
20    VFE(I)=-VFE(I)                                                    ASNE  35
C-------  CALCUL DE LA MATRICE GLOBALE                                  ASNE  36
      IF(IKT.EQ.0) GO TO 30                                             ASNE  37
      ICOD=4                                                            ASNE  38
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASNE  39
C-------  ASSEMBLAGE DES RESIDUS ET DE LA MATRICE GLOBALE               ASNE  40
30    CALL ASSEL(IKT,1,IDLE,NSYM,KLOCE,KLD,VKE,VFE,VKGS,VKGD,VKGI,VRES) ASNE  41
40    ITPE1=ITPE                                                        ASNE  42
      RETURN                                                            ASNE  43
      END                                                               ASNE  44
                                                                                
      SUBROUTINE INIT(X,N,V)                                            INIT   1
C=======================================================================INIT   2
C     INITIALISATION DU VECTEUR V A LA VALEUR X                         INIT   3
C=======================================================================INIT   4
      IMPLICIT REAL*8(A-H,O-Z)                                          INIT   5
      DIMENSION V(1)                                                    INIT   6
C-----------------------------------------------------------------------INIT   7
      DO 10 I=1,N                                                       INIT   8
10    V(I)=X                                                            INIT   9
      RETURN                                                            INIT  10
      END                                                               INIT  11
                                                                                
      SUBROUTINE MAJ(X1,X2,N,V1,V2)                                     MAJ    1
C=======================================================================MAJ    2
C     EXECUTION DE L'OPERATION VECTORIELLE: V2=X1*V1 + X2*V2            MAJ    3
C       X1,X2:SCALAIRES   V1,V2:VECTEURS                                MAJ    4
C=======================================================================MAJ    5
      IMPLICIT REAL*8(A-H,O-Z)                                          MAJ    6
      DIMENSION V1(1),V2(1)                                             MAJ    7
C-----------------------------------------------------------------------MAJ    8
      DO 10 I=1,N                                                       MAJ    9
10    V2(I)=X1*V1(I)+X2*V2(I)                                           MAJ   10
      RETURN                                                            MAJ   11
      END                                                               MAJ   12
                                                                                
      SUBROUTINE NORME(N,VDEL,V,XNORM)                                  NORM   1
C=======================================================================NORM   2
C     CALCUL DU RAPPORT DES LONGUEURS DES VECTEURS VDEL ET V            NORM   3
C=======================================================================NORM   4
      IMPLICIT REAL*8(A-H,O-Z)                                          NORM   5
      DIMENSION VDEL(1),V(1)                                            NORM   6
      DATA ZERO/0.D0/,UN/1.D0/,FAC/1.D-3/                               NORM   7
      SQRT(X)=DSQRT(X)                                                  NORM   8
C-----------------------------------------------------------------------NORM   9
      C1=ZERO                                                           NORM  10
      C2=ZERO                                                           NORM  11
      DO 10 I=1,N                                                       NORM  12
      C1=C1+VDEL(I)*VDEL(I)                                             NORM  13
10    C2=C2+V(I)*V(I)                                                   NORM  14
      C=C1*FAC                                                          NORM  15
      IF(C2.LE.C) C2=UN                                                 NORM  16
      XNORM=SQRT(C1/C2)                                                 NORM  17
      RETURN                                                            NORM  18
      END                                                               NORM  19
C++++++  FIN FIGURE 6.24                                                        
C++++++  DEBUT FIGURE 6.25                                                      
      SUBROUTINE BLTEMP                                                 BLTE   1
C=======================================================================BLTE   2
C     APPEL DU BLOC 'TEMP'                                              BLTE   3
C     RESOLUTION D'UN PROBLEME NON STATIONNAIRE LINEAIRE OU NON         BLTE   4
C=======================================================================BLTE   5
      IMPLICIT REAL*8(A-H,O-Z)                                          BLTE   6
      REAL*4 TBL                                                        BLTE   7
      COMMON/ELEM/NUL(4),ME                                             BLTE   8
      COMMON/ASSE/NSYM,NKG,NKE,NDLE                                     BLTE   9
      COMMON/RESO/NEQ                                                   BLTE  10
      COMMON/NLIN/EPSDL,XNORM,OMEGA,XPAS,DPAS,DPAS0,NPAS,IPAS,NITER,    BLTE  11
     1  ITER,IMETH                                                      BLTE  12
      COMMON/ES/M,MR,MP,M1,M2,M3,M4                                     BLTE  13
      COMMON/LOC/LCORG,LDLNC,LNEQ,LDIMP,LPRNG,LPREG,LLD,LLOCE,LCORE,LNE,BLTE  14
     1  LPRNE,LPREE,LDLE,LKE,LFE,LKGS,LKGD,LKGI,LFG,LRES,LDLG,LME,      BLTE  15
     1  LDLE0,LDLG0,LFG0                                                BLTE  16
      COMMON VA(1)                                                      BLTE  17
      DIMENSION TBL(13),IN(2),XIN(3)                                    BLTE  18
      DATA TBL/4HKGS ,4HKGD ,4HKGI ,4HFG  ,4HKE  ,                      BLTE  19
     1  4HFE  ,4HRES ,4HDLE ,4HDLG ,4HME  ,4HDLE0,4HDLG0,4HFG0 /        BLTE  20
C-----------------------------------------------------------------------BLTE  21
      IF(M1.EQ.0) M1=MR                                                 BLTE  22
      IF(M2.EQ.0) M2=ME                                                 BLTE  23
      WRITE(MP,2000) M                                                  BLTE  24
2000  FORMAT(//' RESOLUTION NON STATIONNAIRE (M=',I2,')'/1X,23('='))    BLTE  25
C-------  ALLOCATION D'ESPACE                                           BLTE  26
      IF(LKGS.EQ.1) CALL ESPACE(NKG,1,TBL(1),LKGS)                      BLTE  27
      IF(LKGD.EQ.1) CALL ESPACE(NEQ,1,TBL(2),LKGD)                      BLTE  28
      IF(NSYM.EQ.1.AND.LKGI.EQ.1) CALL ESPACE(NKG,1,TBL(3),LKGI)        BLTE  29
      IF(LFG.EQ.1) CALL ESPACE (NEQ,1,TBL(4),LFG)                       BLTE  30
      IF(LKE.EQ.1) CALL ESPACE(NKE,1,TBL(5),LKE)                        BLTE  31
      IF(LFE.EQ.1) CALL ESPACE(NDLE,1,TBL(6),LFE)                       BLTE  32
      IF(LRES.EQ.1) CALL ESPACE(NEQ,1,TBL(7),LRES)                      BLTE  33
      IF(LDLE.EQ.1) CALL ESPACE(NDLE,1,TBL(8),LDLE)                     BLTE  34
      IF(LDLG.EQ.1) CALL ESPACE(NEQ,1,TBL(9),LDLG)                      BLTE  35
      IF(LME.EQ.1) CALL ESPACE(NKE,1,TBL(10),LME)                       BLTE  36
      IF(LDLE0.EQ.1) CALL ESPACE(NDLE,1,TBL(11),LDLE0)                  BLTE  37
      IF(LDLG0.EQ.1) CALL ESPACE(NEQ,1,TBL(12),LDLG0)                   BLTE  38
      IF(LFG0.EQ.1) CALL ESPACE(NEQ,1,TBL(13),LFG0)                     BLTE  39
C-------  EXECUTION DU BLOC                                             BLTE  40
      CALL EXTEMP(VA(LCORG),VA(LDLNC),VA(LDIMP),VA(LNEQ),VA(LLD),       BLTE  41
     1  VA(LLOCE),VA(LCORE),VA(LPRNE),VA(LPREE),VA(LNE),VA(LKE),VA(LME),BLTE  42
     2  VA(LFE),VA(LDLE),VA(LKGS),VA(LKGD),VA(LKGI),VA(LFG),VA(LRES),   BLTE  43
     3  VA(LDLG),VA(LDLE0),VA(LDLG0),VA(LFG0))                          BLTE  44
      RETURN                                                            BLTE  45
      END                                                               BLTE  46
                                                                                
      SUBROUTINE EXTEMP(VCORG,KDLNC,VDIMP,KNEQ,KLD,KLOCE,VCORE,VPRNE,   EXTE   1
     1  VPREE,KNE,VKE,VME,VFE,VDLE,VKGS,VKGD,VKGI,VFG,VRES,VDLG,        EXTE   2
     2  VDLE0,VDLG0,VFG0)                                               EXTE   3
C=======================================================================EXTE   4
C     EXECUTION DU BLOC 'TEMP'                                          EXTE   5
C     RESOLUTION D'UN PROBLEME NON STATIONNAIRE LINEAIRE OU NON         EXTE   6
C=======================================================================EXTE   7
      IMPLICIT REAL*8(A-H,O-Z)                                          EXTE   8
      COMMON/RESO/NEQ                                                   EXTE   9
      COMMON/COND/NCLT,NCLZ,NCLNZ                                       EXTE  10
      COMMON/ASSE/NSYM                                                  EXTE  11
      COMMON/NLIN/EPSDL,XNORM,OMEGA,XPAS,DPAS,DPAS0,NPAS,IPAS,NITER,    EXTE  12
     1  ITER,IMETH                                                      EXTE  13
      COMMON/ES/M,MR,MP,M1,M2,M3,M4                                     EXTE  14
      DIMENSION VCORG(1),KDLNC(1),VDIMP(1),KNEQ(1),KLD(1),KLOCE(1),     EXTE  15
     1  VCORE(1),VPRNE(1),VPREE(1),KNE(1),VKE(1),VME(1),VFE(1),VDLE(1), EXTE  16
     2  VKGS(1),VKGD(1),VKGI(1),VFG(1),VRES(1),VDLG(1),VDLE0(1),        EXTE  17
     3  VDLG0(1),VFG0(1)                                                EXTE  18
      DATA ZERO/0.D0/,UN/1.D0/                                          EXTE  19
C-----------------------------------------------------------------------EXTE  20
      DPAS0=ZERO                                                        EXTE  21
      XPAS=ZERO                                                         EXTE  22
      IPAS=0                                                            EXTE  23
C-------  LECTURE DES DEGRES DE LIBERTE INITIAUX SUR LE FICHIER M3      EXTE  24
      IF(M3.EQ.0) GO TO 5                                               EXTE  25
      REWIND M3                                                         EXTE  26
      READ(M3) (VDLG(I),I=1,NEQ)                                        EXTE  27
      CALL MAJ(UN,ZERO,NEQ,VDLG,VDLG0)                                  EXTE  28
C-------  SAUVER L'ETAT DE SOLLICITATION DE REFERENCE                   EXTE  29
5     CALL MAJ(UN,ZERO,NEQ,VFG,VFG0)                                    EXTE  30
C-------  LIRE UNE CARTE DEFINISSANT UN ENSEMBLE DE PAS IDENTIQUES      EXTE  31
10    READ(M1,1000) DPAS,I1,I2,I3,X1,X2                                 EXTE  32
1000  FORMAT(F10.0,3I5,2F10.0)                                          EXTE  33
      IF(DPAS.EQ.ZERO) GO TO 140                                        EXTE  34
      IF(I1.GT.0) NPAS=I1                                               EXTE  35
      IF(I2.GT.0) NITER=I2                                              EXTE  36
      IF(I3.GT.0) IMETH=I3                                              EXTE  37
      IF(X1.GT.ZERO) EPSDL=X1                                           EXTE  38
      IF(X2.NE.ZERO) OMEGA=X2                                           EXTE  39
C                                                                       EXTE  40
C-------  BOUCLE SUR LES PAS                                            EXTE  41
C                                                                       EXTE  42
      DO 130 IP=1,NPAS                                                  EXTE  43
      CALL INIT(ZERO,NEQ,VFG)                                           EXTE  44
      IPAS=IPAS+1                                                       EXTE  45
      XPAS=XPAS+DPAS                                                    EXTE  46
      WRITE(MP,2000) IPAS,DPAS,XPAS,NITER,IMETH,EPSDL,OMEGA             EXTE  47
2000  FORMAT(/1X,13('-'),'PAS NUMERO (IPAS):',I5//                      EXTE  48
     1               14X,'ACCROISSEMENT              (DPAS)=',E12.5/    EXTE  49
     2               14X,'NIVEAU TOTAL               (XPAS)=',E12.5/    EXTE  50
     3               14X,'NOMBRE D ITERATIONS       (NITER)=',I12/      EXTE  51
     4               14X,'METHODE NUMERO            (IMETH):',I12/      EXTE  52
     5               14X,'PRECISION                 (EPSDL)=',E12.5/    EXTE  53
     6               14X,'COEFFICIENT ALPHA         (OMEGA)=',E12.5/)   EXTE  54
C                                                                       EXTE  55
C-------  BOUCLE SUR LES ITERATIONS D'EQUILIBRE                         EXTE  56
C                                                                       EXTE  57
      DO 110 ITER=1,NITER                                               EXTE  58
C-------  CHOIX DE LA METHODE                                           EXTE  59
      IF(IMETH.GT.3) GO TO 20                                           EXTE  60
C-------  METHODES DE TYPE EULER                                        EXTE  61
      CALL EULER(VCORG,KDLNC,VDIMP,KNEQ,KLD,KLOCE,VCORE,VPRNE,VPREE,    EXTE  62
     1  KNE,VKE,VME,VFE,VDLE,VKGS,VKGD,VKGI,VFG,VRES,VDLG,              EXTE  63
     2  VDLE0,VDLG0,VFG0)                                               EXTE  64
      GO TO 100                                                         EXTE  65
C-------  AUTRES METHODES ......                                        EXTE  66
20    CONTINUE                                                          EXTE  67
      WRITE(MP,2010) IMETH                                              EXTE  68
2010  FORMAT(' ** ERREUR, METHODE:',I3,' INCONNUE')                     EXTE  69
      STOP                                                              EXTE  70
C-------  CALCUL DE LA NORME                                            EXTE  71
100   CALL NORME(NEQ,VRES,VDLG,XNORM)                                   EXTE  72
      IF(M.GT.0) WRITE(MP,2020) ITER,XNORM                              EXTE  73
2020  FORMAT(5X,'ITERATION (ITER):',I3,' NORME (XNORM)=',E12.5)         EXTE  74
      IF(M.GE.2) CALL PRSOL(KDLNC,VCORG,VDIMP,KNEQ,VDLG)                EXTE  75
      IF(XNORM.LE.EPSDL) GO TO 120                                      EXTE  76
110   CONTINUE                                                          EXTE  77
C-------  FIN DU PAS                                                    EXTE  78
120   DPAS0=DPAS                                                        EXTE  79
      CALL MAJ(UN,ZERO,NEQ,VDLG,VDLG0)                                  EXTE  80
      CALL PRSOL(KDLNC,VCORG,VDIMP,KNEQ,VDLG)                           EXTE  81
130   CONTINUE                                                          EXTE  82
      GO TO 10                                                          EXTE  83
C-------  SAUVEGARDE DE LA SOLUTION SUR FICHIER M4                      EXTE  84
140   IF(M4.NE.0) WRITE(M4) (VDLG(I),I=1,NEQ)                           EXTE  85
      RETURN                                                            EXTE  86
      END                                                               EXTE  87
                                                                                
      SUBROUTINE EULER(VCORG,KDLNC,VDIMP,KNEQ,KLD,KLOCE,VCORE,VPRNE,    EULE   1
     1  VPREE,KNE,VKE,VME,VFE,VDLE,VKGS,VKGD,VKGI,VFG,VRES,VDLG,        EULE   2
     2  VDLE0,VDLG0,VFG0)                                               EULE   3
C=======================================================================EULE   4
C     ALGORITHME DES METHODES DE TYPE EULER (IMPLICITE,EXPLICITE OU     EULE   5
C     MIXTE SELON OMEGA) POUR DES PROBLEMES LINEAIRES OU NON LINEAIRES  EULE   6
C     LE PROBLEME NON LINEAIRE EST RESOLU PAR UNE METHODE DE TYPE       EULE   7
C     NEWTON-RAPHSON                                                    EULE   8
C       IMETH.EQ.1  NEWTON-RAPHSON STANDARD                             EULE   9
C       IMETH.EQ.2  K CONSTANTE                                         EULE  10
C       IMETH.EQ.3  K RECALCULEE AU DEBUT DE CHAQUE PAS                 EULE  11
C=======================================================================EULE  12
      IMPLICIT REAL*8(A-H,O-Z)                                          EULE  13
      COMMON/ASSE/NSYM,NKG                                              EULE  14
      COMMON/RESO/NEQ                                                   EULE  15
      COMMON/NLIN/EPSDL,XNORM,OMEGA,XPAS,DPAS,DPAS0,NPAS,IPAS,NITER,    EULE  16
     1  ITER,IMETH                                                      EULE  17
      COMMON/ES/M,MR,MP                                                 EULE  18
      DIMENSION VCORG(1),KDLNC(1),VDIMP(1),KNEQ(1),KLD(1),KLOCE(1),     EULE  19
     1  VCORE(1),VPRNE(1),VPREE(1),KNE(1),VKE(1),VME(1),VFE(1),         EULE  20
     2  VDLE(1),VKGS(1),VKGD(1),VKGI(1),VFG(1),VRES(1),VDLG(1),         EULE  21
     3  VDLE0(1),VDLG0(1),VFG0(1)                                       EULE  22
      DATA ZERO/0.D0/,UN/1.D0/                                          EULE  23
C-----------------------------------------------------------------------EULE  24
C-------  DECISION DE REASSEMBLAGE DE LA MATRICE GLOBALE                EULE  25
      IKT=0                                                             EULE  26
      IF(IMETH.EQ.1) GO TO 10                                           EULE  27
      IF(DPAS.NE.DPAS0.AND.ITER.EQ.1) GO TO 10                          EULE  28
      IF(IMETH.EQ.3.AND.ITER.EQ.1) GO TO 10                             EULE  29
      GO TO 20                                                          EULE  30
10    IKT=1                                                             EULE  31
C-------  INITIALISER A ZERO LA MATRICE GLOBALE SI NECESSAIRE           EULE  32
20    IF(IKT.EQ.0) GO TO 30                                             EULE  33
      CALL INIT(ZERO,NKG,VKGS)                                          EULE  34
      CALL INIT(ZERO,NEQ,VKGD)                                          EULE  35
      IF(NSYM.EQ.1) CALL INIT(ZERO,NKG,VKGI)                            EULE  36
C-------  ASSEMBLAGE DES RESIDUS ET DE LA MATRICE GLOBALE SI NECESSAIRE EULE  37
30    CALL MAJ(UN,ZERO,NEQ,VFG0,VRES)                                   EULE  38
      CALL ASEULR(IKT,VCORG,KDLNC,VDIMP,KNEQ,KLD,KLOCE,VCORE,VPRNE,     EULE  39
     1  VPREE,KNE,VKE,VME,VFE,VDLE,VKGS,VKGD,VKGI,VFG,VRES,VDLG,        EULE  40
     2  VDLE0,VDLG0,VFG0)                                               EULE  41
      C1=UN                                                             EULE  42
      IF(ITER.GT.1) C1=C1-OMEGA                                         EULE  43
      DO 40 I=1,NEQ                                                     EULE  44
40    VRES(I)=DPAS*(VRES(I)-C1*VFG(I))                                  EULE  45
C-------  RESOLUTION                                                    EULE  46
      CALL SOL(VKGS,VKGD,VKGI,VRES,KLD,NEQ,MP,IKT,1,NSYM,ENERG)         EULE  47
C-------  MISE A JOUR DE LA SOLUTION                                    EULE  48
      CALL MAJ(UN,UN,NEQ,VRES,VDLG)                                     EULE  49
      RETURN                                                            EULE  50
      END                                                               EULE  51
                                                                                
      SUBROUTINE ASEULR(IKT,VCORG,KDLNC,VDIMP,KNEQ,KLD,KLOCE,VCORE,     ASEU   1
     1  VPRNE,VPREE,KNE,VKE,VME,VFE,VDLE,VKGS,VKGD,VKGI,VFG,VRES,       ASEU   2
     2  VDLG,VDLE0,VDLG0,VFG0)                                          ASEU   3
C=======================================================================ASEU   4
C     ASSEMBLAGE DES RESIDUS ET DE LA MATRICE GLOBALE (SI IKT.EQ.1)     ASEU   5
C     DANS LA MEME BOUCLE SUR LES ELEMENTS (POUR LA METHODE DE EULER)   ASEU   6
C=======================================================================ASEU   7
      IMPLICIT REAL*8(A-H,O-Z)                                          ASEU   8
      COMMON/ELEM/NELT,NNEL,NTPE,NGRE,ME,NIDENT                         ASEU   9
      COMMON/ASSE/NSYM                                                  ASEU  10
      COMMON/RESO/NEQ                                                   ASEU  11
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGASEU  12
     1  ,ICOD                                                           ASEU  13
      COMMON/NLIN/EPSDL,XNORM,OMEGA,XPAS,DPAS,DPAS0,NPAS,IPAS,NITER,    ASEU  14
     1  ITER,IMETH                                                      ASEU  15
      COMMON/ES/M,MR,MP,M1,M2                                           ASEU  16
      DIMENSION VCORG(1),KDLNC(1),VDIMP(1),KNEQ(1),KLD(1),KLOCE(1),     ASEU  17
     1  VCORE(1),VPRNE(1),VPREE(1),KNE(1),VKE(1),VME(1),VFE(1),VDLE(1), ASEU  18
     2  VKGS(1),VKGD(1),VKGI(1),VFG(1),VRES(1),VDLG(1),VDLE0(1),        ASEU  19
     3  VDLG0(1),VFG0(1)                                                ASEU  20
      DATA UN/1.D0/                                                     ASEU  21
C-----------------------------------------------------------------------ASEU  22
      CC=DPAS*OMEGA                                                     ASEU  23
      IFE=0                                                             ASEU  24
      IF(ITER.GT.1) IFE=1                                               ASEU  25
C-------  POSITIONNER AU DEBUT LE FICHIER DES ELEMENTS (ME)             ASEU  26
      REWIND M2                                                         ASEU  27
C-------  BOUCLE SUR LES ELEMENTS                                       ASEU  28
      DO 90 IE=1,NELT                                                   ASEU  29
C-------  LIRE UN ELEMENT                                               ASEU  30
      CALL RDELEM(M2,KLOCE,VCORE,VPRNE,VPREE,KNE)                       ASEU  31
C-------  CALCUL DES FONCTIONS D'INTERPOLATION SI NECESSAIRE            ASEU  32
      IF(ITPE.EQ.ITPE1) GO TO 10                                        ASEU  33
      ICOD=2                                                            ASEU  34
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASEU  35
C-------  EXTRAIRE LES D.L. DE L'ELEMENT DE VFG                         ASEU  36
10    CALL DLELM(KLOCE,VDLG,VDIMP,VDLE)                                 ASEU  37
C-------  CALCUL DU RESIDU K.U                                          ASEU  38
      ICOD=6                                                            ASEU  39
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASEU  40
C-------  CALCUL DE LA MATRICE M                                        ASEU  41
      ICOD=5                                                            ASEU  42
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VME,VFE)                       ASEU  43
C-------  CALCUL DE LA MATRICE K SI NECESSAIRE                          ASEU  44
      IF(IKT.EQ.0) GO TO 15                                             ASEU  45
      ICOD=3                                                            ASEU  46
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASEU  47
C-------  RESIDUS A LA PREMIERE ITERATION DE CHAQUE PAS (LINEAIRE)      ASEU  48
15    IF(ITER.GT.1) GO TO 20                                            ASEU  49
      CALL ASSEL(0,1,IDLE,NSYM,KLOCE,KLD,VKE,VFE,VKGS,VKGD,VKGI,VFG)    ASEU  50
      GO TO 60                                                          ASEU  51
C-------  RESIDUS APRES LA PREMIERE ITERATION                           ASEU  52
20    CALL DLELM(KLOCE,VDLG0,VDIMP,VDLE0)                               ASEU  53
      DO 30 I=1,IDLE                                                    ASEU  54
      VDLE(I)=(VDLE0(I)-VDLE(I))/DPAS                                   ASEU  55
30    VFE(I)=-OMEGA*VFE(I)                                              ASEU  56
C-------  PRODUIT M . U                                                 ASEU  57
      VFE(1)=VFE(1)+VME(1)*VDLE(1)                                      ASEU  58
      II=1                                                              ASEU  59
      DO 50 J=2,IDLE                                                    ASEU  60
      J1=J-1                                                            ASEU  61
      DO 40 I=1,J1                                                      ASEU  62
      II=II+1                                                           ASEU  63
      VFE(I)=VFE(I)+VME(II)*VDLE(J)                                     ASEU  64
40    VFE(J)=VFE(J)+VME(II)*VDLE(I)                                     ASEU  65
      II=II+1                                                           ASEU  66
50    VFE(J)=VFE(J)+VME(II)*VDLE(J)                                     ASEU  67
C-------  MATRICE    M + DPAS.OMEGA. K                                  ASEU  68
60    IF(IKT.EQ.0) GO TO 80                                             ASEU  69
      II=0                                                              ASEU  70
      DO 70 I=1,IDLE                                                    ASEU  71
      DO 70 J=I,IDLE                                                    ASEU  72
      II=II+1                                                           ASEU  73
70    VKE(II)=VKE(II)*CC+VME(II)                                        ASEU  74
C-------  ASSEMBLAGE DU RESIDU ET DE LA MATRICE GLOBALE                 ASEU  75
80    CALL ASSEL(IKT,IFE,IDLE,NSYM,KLOCE,KLD,VKE,VFE,VKGS,VKGD,VKGI,    ASEU  76
     1  VRES)                                                           ASEU  77
90    ITPE1=ITPE                                                        ASEU  78
      RETURN                                                            ASEU  79
      END                                                               ASEU  80
C++++++  FIN FIGURE 6.25                                                        
C++++++  DEBUT FIGURE 6.26
      SUBROUTINE BLVALP                                                 BLVA   1
C=======================================================================BLVA   2
C     APPEL DU BLOC 'VALP'                                              BLVA   3
C     CALCUL DES VALEURS ET VECTEURS PROPRES PAR ITERATION SUR UN       BLVA   4
C     SOUS-ESPACE                                                       BLVA   5
C=======================================================================BLVA   6
      IMPLICIT REAL*8(A-H,O-Z)                                          BLVA   7
      REAL*4 TBL                                                        BLVA   8
      COMMON/ELEM/NUL(4),ME                                             BLVA   9
      COMMON/ASSE/NSYM,NKG,NKE,NDLE                                     BLVA  10
      COMMON/RESO/NEQ                                                   BLVA  11
      COMMON/VALP/NITER,NMDIAG,EPSLB,SHIFT,NSS,NSWM,TOLJAC,NVALP        BLVA  12
      COMMON/ES/M,MR,MP,M1,M2                                           BLVA  13
      COMMON/LOC/LCORG,LDLNC,LNEQ,LDIMP,LPRNG,LPREG,LLD,LLOCE,LCORE,LNE,BLVA  14
     1  LPRNE,LPREE,LDLE,LKE,LFE,LKGS,LKGD,LKGI,LFG,LRES,LDLG           BLVA  15
      COMMON/TRVL/X1,X2,X3,I1,I2,I3,I4,I5                               BLVA  16
      COMMON VA(1)                                                      BLVA  17
      DIMENSION TBL(20)                                                 BLVA  18
      DATA TBL/4HKGS ,4HKGD ,4HMGS ,4HMGD ,4HFG  ,4HKE  ,4HFE  ,4HDLE , BLVA  19
     1  4HRES ,4HDLG ,4HP   ,4HLAMB,4HLAM1,4HR   ,4HPHI ,4HKSS ,4HMSS , BLVA  20
     1  4HV1  ,4HVX  ,4HV2  /,ZERO/0.D0/                                BLVA  21
C-----------------------------------------------------------------------BLVA  22
      IF(M1.EQ.0) M1=MR                                                 BLVA  23
      IF(M2.EQ.0) M2=ME                                                 BLVA  24
      READ(M1,1000) I1,I2,X1,X2,I3,I4,I5,X3                             BLVA  25
1000  FORMAT(2I5,2F10.0,3I5,1F10.0)                                     BLVA  26
      IF(I1.NE.0) NVALP=I1                                              BLVA  27
      IF(I2.NE.0) NITER=I2                                              BLVA  28
      NSS=I3                                                            BLVA  29
      IF(I4.NE.0) NMDIAG=I4                                             BLVA  30
      IF(I5.NE.0) NSWM=I5                                               BLVA  31
      IF(X1.NE.ZERO) EPSLB=X1                                           BLVA  32
      IF(X2.NE.ZERO) SHIFT=X2                                           BLVA  33
      IF(X3.NE.ZERO) TOLJAC=X3                                          BLVA  34
      IF(NSS.NE.0) GO TO 10                                             BLVA  35
      NSS=MIN0(NVALP+8,2*NVALP)                                         BLVA  36
      NSS=MIN0(NSS,NEQ)                                                 BLVA  37
10    CONTINUE                                                          BLVA  38
      WRITE(MP,2000) M,NVALP,NITER,NMDIAG,EPSLB,SHIFT,NSS,NSWM,TOLJAC   BLVA  39
2000  FORMAT(//' ITERATION PAR SOUS-ESPACE (M=',I2,')'/' ',26('=')/     BLVA  40
     1  15X,'NOMBRE DE VALEURS PROPRES DESIREES       (NVALP)=',I12/    BLVA  41
     2  15X,'NOMBRE D ITERATIONS MAX.                 (NITER)=',I12/    BLVA  42
     3  15X,'INDICE DE MASSE DIAGONALE               (NMDIAG)=',I12/    BLVA  43
     4  15X,'PRECISION SUR LES VALEURS PROPRES        (EPSLB)=',E12.5/  BLVA  44
     5  15X,'DECALAGE                                 (SHIFT)=',E12.5/  BLVA  45
     6  15X,'DIMENSION DU SOUS-ESPACE                   (NSS)=',I12/    BLVA  46
     7  15X,'NOMBRE MAX. D ITERATIONS DANS JACOBI      (NSWM)=',I12/    BLVA  47
     8  15X,'TOLERANCE DANS JACOBI                   (TOLJAC)=',1E12.5/)BLVA  48
      IF(LKGS.EQ.1) CALL ESPACE(NKG,1,TBL(1),LKGS)                      BLVA  49
      IF(LKGD.EQ.1) CALL ESPACE(NEQ,1,TBL(2),LKGD)                      BLVA  50
      CALL ESPACE(NKG,1,TBL(3),LMGS)                                    BLVA  51
      CALL ESPACE(NEQ,1,TBL(4),LMGD)                                    BLVA  52
      IF(LFG.EQ.1) CALL ESPACE(NEQ,1,TBL(5),LFG)                        BLVA  53
      IF(LKE.EQ.1) CALL ESPACE(NKE,1,TBL(6),LKE)                        BLVA  54
      IF(LFE.EQ.1) CALL ESPACE(NDLE,1,TBL(7),LFE)                       BLVA  55
      IF(LDLE.EQ.1) CALL ESPACE(NDLE,1,TBL(8),LDLE)                     BLVA  56
      IF(LRES.EQ.1) CALL ESPACE(NEQ,1,TBL(9),LRES)                      BLVA  57
      IF(LDLG.EQ.1) CALL ESPACE(NEQ,1,TBL(10),LDLG)                     BLVA  58
      CALL ESPACE(NEQ*NSS,1,TBL(11),LVEC)                               BLVA  59
      CALL ESPACE(NSS,1,TBL(12),LLAMB)                                  BLVA  60
      CALL ESPACE(NSS,1,TBL(13),LLAM1)                                  BLVA  61
      CALL ESPACE(NSS*(NSS+1)/2,1,TBL(16),LKSS)                         BLVA  62
      CALL ESPACE(NSS*(NSS+1)/2,1,TBL(17),LMSS)                         BLVA  63
      CALL ESPACE(NEQ,1,TBL(18),LV1)                                    BLVA  64
      CALL ESPACE(NSS*NSS,1,TBL(19),LX)                                 BLVA  65
      CALL EXVALP(VA(LLD),VA(LDIMP),VA(LLOCE),VA(LCORE),VA(LPRNE),      BLVA  66
     1  VA(LPREE),VA(LNE),VA(LFE),VA(LKE),VA(LKGS),VA(LKGD),VA(LFG),    BLVA  67
     2  VA(LCORG),VA(LDLNC),VA(LNEQ),VA(LRES),VA(LDLE),VA(LDLG),        BLVA  68
     3  VA(LMGS),VA(LMGD),VA(LVEC),VA(LLAMB),VA(LLAM1),VA(LKSS),VA(LMSS)BLVA  69
     4  ,VA(LV1),VA(LX),NEQ,NSS)                                        BLVA  70
      RETURN                                                            BLVA  71
      END                                                               BLVA  72
 
      SUBROUTINE EXVALP(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VFE,VKE,  EXVA   1
     1  VKGS,VKGD,VFG,VCORG,KDLNC,KNEQ,VRES,VDLE,VDLG,VMGS,VMGD,        EXVA   2
     2  VEC,VLAMB,VLAM1,VKSS,VMSS,V1,VX,NEQ,NSS)                        EXVA   3
C=======================================================================EXVA   4
C     EXECUTION DU BLOC 'VALP'                                          EXVA   5
C     CALCUL DES VALEURS ET VECTEURS PROPRES PAR ITERATION SUR UN       EXVA   6
C     SOUS-ESPACE                                                       EXVA   7
C=======================================================================EXVA   8
      IMPLICIT REAL*8(A-H,O-Z)                                          EXVA   9
      COMMON/ASSE/NSYM,NKG,NKE,NDLE                                     EXVA  10
      COMMON/VALP/NITER,NMDIAG,EPSLB,SHIFT,NSS1,NSWM,TOLJAC,NVALP       EXVA  11
      COMMON/ES/M,MR,MP                                                 EXVA  12
      DIMENSION KLD(1),VDIMP(1),KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),    EXVA  13
     1  KNE(1),VFE(1),VKE(1),VKGS(1),VKGD(1),VFG(1),VCORG(1),KDLNC(1),  EXVA  14
     2  KNEQ(1),VRES(1),VDLE(1),VDLG(1),VMGS(1),VMGD(1),VEC(NEQ,1),     EXVA  15
     3  VLAMB(1),VLAM1(1),VKSS(1),VMSS(1),V1(1),VX(NSS,1)               EXVA  16
      DATA ZERO/0.D0/,UN/1.0D0/                                         EXVA  17
      ABS(X)=DABS(X)                                                    EXVA  18
C-----------------------------------------------------------------------EXVA  19
C                                                                       EXVA  20
C-------  CALCULS PRELIMINAIRES                                         EXVA  21
C                                                                       EXVA  22
C-------  ASSEMBLER KG ET MG                                            EXVA  23
      CALL ASKG(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,VKGS,VKGD,EXVA  24
     1  VKGI,VFG,VDLE,VRES)                                             EXVA  25
      CALL ASMG(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,VMGS,     EXVA  26
     1  VMGD,VMGS,VFG,VDLE,VRES)                                        EXVA  27
C-------  TRIANGULARISER KG                                             EXVA  28
      CALL SOL(VKGS,VKGD,VKGI,VFG,KLD,NEQ,MP,1,0,0,ENERG)               EXVA  29
C-------  VECTEUR DES SOLLICITATIONS EGAL A LA  DIAGONALE DE M          EXVA  30
      CMAX=ZERO                                                         EXVA  31
      DO 10 ID=1,NEQ                                                    EXVA  32
      C=VKGD(ID)/VMGD(ID)                                               EXVA  33
      V1(ID)=C                                                          EXVA  34
      IF(C.GT.CMAX) CMAX=C                                              EXVA  35
      VEC(ID,1)=VMGD(ID)                                                EXVA  36
      DO 10 JS=2,NSS                                                    EXVA  37
10    VEC(ID,JS)=ZERO                                                   EXVA  38
C-------  VECTEURS DES SOLLICITATIONS UNITES CORRESPONDANTS AUX MIN. DE EXVA  39
C         K(I,I)/M(I,I)                                                 EXVA  40
      DO 30 JS=2,NSS                                                    EXVA  41
      C=CMAX                                                            EXVA  42
      DO 20 ID=1,NEQ                                                    EXVA  43
      IF(V1(ID).GT.C) GO TO 20                                          EXVA  44
      C=V1(ID)                                                          EXVA  45
      II=ID                                                             EXVA  46
20    CONTINUE                                                          EXVA  47
      V1(II)=CMAX                                                       EXVA  48
      VEC(II,JS)=UN                                                     EXVA  49
30    VLAMB(JS)=UN                                                      EXVA  50
      VLAMB(1)=UN                                                       EXVA  51
C                                                                       EXVA  52
C-------  DEBUT DES ITERATIONS                                          EXVA  53
C                                                                       EXVA  54
      ITERM=0                                                           EXVA  55
      ITMAX=NITER+1                                                     EXVA  56
      DO 200 ITER=1,ITMAX                                               EXVA  57
C-------  CALCUL DES VECTEURS DE RITZ                                   EXVA  58
      II0=0                                                             EXVA  59
      DO 80 JS=1,NSS                                                    EXVA  60
      II0=II0+JS                                                        EXVA  61
      DO 40 ID=1,NEQ                                                    EXVA  62
40    V1(ID)=VEC(ID,JS)                                                 EXVA  63
      CALL SOL(VKGS,VKGD,VKGI,V1,KLD,NEQ,MP,0,1,0,ENERG)                EXVA  64
C-------  CALCUL DE LA PROJECTION DE K                                  EXVA  65
      II=II0                                                            EXVA  66
      DO 60 IS=JS,NSS                                                   EXVA  67
      C=ZERO                                                            EXVA  68
      DO 50 ID=1,NEQ                                                    EXVA  69
50    C=C+V1(ID)*VEC(ID,IS)                                             EXVA  70
      VKSS(II)=C                                                        EXVA  71
60    II=II+IS                                                          EXVA  72
      DO 70 ID=1,NEQ                                                    EXVA  73
70    VEC(ID,JS)=V1(ID)                                                 EXVA  74
80    CONTINUE                                                          EXVA  75
C-------  PROJECTION DE LA MATRICE M                                    EXVA  76
      II0=0                                                             EXVA  77
      DO 120 JS=1,NSS                                                   EXVA  78
      II0=II0+JS                                                        EXVA  79
      DO 85 ID=1,NEQ                                                    EXVA  80
85    V1(ID)=ZERO                                                       EXVA  81
      CALL MULKU(VMGS,VMGD,VMGS,KLD,VEC(1,JS),NEQ,0,V1)                 EXVA  82
      II=II0                                                            EXVA  83
      DO 100 IS=JS,NSS                                                  EXVA  84
      C=ZERO                                                            EXVA  85
      DO 90 ID=1,NEQ                                                    EXVA  86
90    C=C+V1(ID)*VEC(ID,IS)                                             EXVA  87
      IF(ITERM.GT.0) GO TO 120                                          EXVA  88
      VMSS(II)=C                                                        EXVA  89
100   II=II+IS                                                          EXVA  90
      DO 110 ID=1,NEQ                                                   EXVA  91
110   VEC(ID,JS)=V1(ID)                                                 EXVA  92
120   CONTINUE                                                          EXVA  93
C-------  CALCUL DES VECTEURS PROPRES DANS LE SOUS-ESPACE               EXVA  94
      CALL JACOBI(VKSS,VMSS,NSS,NSWM,TOLJAC,V1,VLAM1,VX)                EXVA  95
C-------  NOUVEAU VECTEUR SOLLICITATIONS                                EXVA  96
      DO 160 ID=1,NEQ                                                   EXVA  97
      DO 130 JS=1,NSS                                                   EXVA  98
130   V1(JS)=VEC(ID,JS)                                                 EXVA  99
      DO 150 JS=1,NSS                                                   EXVA 100
      C=ZERO                                                            EXVA 101
      DO 140 IS=1,NSS                                                   EXVA 102
140   C=C+V1(IS)*VX(IS,JS)                                              EXVA 103
150   VEC(ID,JS)=C                                                      EXVA 104
160   CONTINUE                                                          EXVA 105
C-------  IMPRESSION DE L ITERATION                                     EXVA 106
      IF(M.LT.1) GO TO 180                                              EXVA 107
      WRITE(MP,2000) ITER                                               EXVA 108
2000  FORMAT(//' . . . . . . ITERATION ',I5/)                           EXVA 109
      DO 170 IS=1,NSS                                                   EXVA 110
      WRITE(MP,2010) IS,VLAM1(IS)                                       EXVA 111
2010  FORMAT(/' VALEUR PROPRE NO. ',I5,' =',E12.5//' VECTEUR PROPRE:')  EXVA 112
170   CALL PRSOL(KDLNC,VCORG,VDIMP,KNEQ,VEC(1,IS))                      EXVA 113
C-------  TEST DE CONVERGENCE                                           EXVA 114
180   IF(ITERM.GT.0) GO TO 210                                          EXVA 115
      C=ZERO                                                            EXVA 116
      IEX=0                                                             EXVA 117
      DO 190 IS=1,NSS                                                   EXVA 118
      C1=ABS((VLAM1(IS)-VLAMB(IS))/VLAMB(IS))                           EXVA 119
      IF(C1.GT.C) C=C1                                                  EXVA 120
      IF(C1.LE.EPSLB) IEX=IEX+1                                         EXVA 121
190   CONTINUE                                                          EXVA 122
      WRITE(MP,2015) ITER,C,IEX                                         EXVA 123
2015   FORMAT(' ITERATION ',I4,' ERREUR MAX.=',E9.1,' VALEURS PROPRES EXEXVA 124
     1ACTES:',I4)                                                       EXVA 125
      IF(IEX.GE.NVALP) ITERM=1                                          EXVA 126
C-------  NON CONVERGENCE                                               EXVA 127
      IF(ITER.LT.NITER.OR.ITERM.EQ.1) GO TO 195                         EXVA 128
      WRITE(MP,2020) NITER                                              EXVA 129
2020  FORMAT(' ** NON CONVERGENCE APRES ',I5,' ITERATIONS')             EXVA 130
      ITERM=1                                                           EXVA 131
C-------  SAUVER LES VALEURS PROPRES                                    EXVA 132
195   DO 200 IS=1,NSS                                                   EXVA 133
200   VLAMB(IS)=VLAM1(IS)                                               EXVA 134
C                                                                       EXVA 135
C-------  RESULTAT                                                      EXVA 136
C                                                                       EXVA 137
C-------  PLACER DANS L'ORDRE CROISSANT LES VALEURS PROPRES             EXVA 138
210   IS1=NSS-1                                                         EXVA 139
      DO 230 IS=1,IS1                                                   EXVA 140
      I1=IS+1                                                           EXVA 141
      C=VLAMB(IS)                                                       EXVA 142
      II=IS                                                             EXVA 143
      DO 220 JS=I1,NSS                                                  EXVA 144
      IF(C.LT.VLAMB(JS)) GO TO 220                                      EXVA 145
      C=VLAMB(JS)                                                       EXVA 146
      II=JS                                                             EXVA 147
220   CONTINUE                                                          EXVA 148
      VLAMB(II)=VLAMB(IS)                                               EXVA 149
      VLAMB(IS)=C                                                       EXVA 150
      DO 230 ID=1,NEQ                                                   EXVA 151
      C=VEC(ID,IS)                                                      EXVA 152
      VEC(ID,IS)=VEC(ID,II)                                             EXVA 153
230   VEC(ID,II)=C                                                      EXVA 154
C-------  IMPRESSION                                                    EXVA 155
      WRITE(MP,2030) ITER                                               EXVA 156
2030  FORMAT(/' . . . . CONVERGENCE EN',I4,' ITERATIONS'/)              EXVA 157
      DO 240 IS=1,NVALP                                                 EXVA 158
      WRITE(MP,2010) IS,VLAMB(IS)                                       EXVA 159
240   CALL PRSOL(KDLNC,VCORG,VDIMP,KNEQ,VEC(1,IS))                      EXVA 160
      RETURN                                                            EXVA 161
      END                                                               EXVA 162
 
      SUBROUTINE ASMG(KLD,VDIMP,KLOCE,VCORE,VPRNE,VPREE,KNE,VKE,VFE,    ASMG   1
     1  VKGS,VKGD,VKGI,VFG,VDLE,VRES)                                   ASMG   2
C=======================================================================ASMG   3
C     ASSEMBLAGE DE LA MATRICE MASSE GLOBALE (FONCTION ELEMENTAIRE 5)   ASMG   4
C=======================================================================ASMG   5
      IMPLICIT REAL*8(A-H,O-Z)                                          ASMG   6
      COMMON/ELEM/NELT,NNEL,NTPE,NGRE,ME,NIDENT                         ASMG   7
      COMMON/ASSE/NSYM                                                  ASMG   8
      COMMON/RESO/NEQ                                                   ASMG   9
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGASMG  10
     1  ,ICOD                                                           ASMG  11
      COMMON/ES/M,MR,MP,M1,M2                                           ASMG  12
      DIMENSION KLD(1),VDIMP(1),KLOCE(1),VCORE(1),VPRNE(1),VPREE(1),    ASMG  13
     1  KNE(1),VKE(1),VFE(1),VKGS(1),VKGD(1),VKGI(1),VFG(1),VDLE(1),    ASMG  14
     2  VRES(1),KEB(1)                                                  ASMG  15
C-----------------------------------------------------------------------ASMG  16
C-------  POSITIONNER AU DEBUT LE FICHIER DES ELEMENTS (M2)             ASMG  17
      REWIND M2                                                         ASMG  18
C-------  BOUCLE SUR LES ELEMENTS                                       ASMG  19
      DO 30 IE=1,NELT                                                   ASMG  20
C-------  NE PAS RECALCULER LES ELEMENTS IDENTIQUES                     ASMG  21
      IF(NIDENT.EQ.1.AND.IE.GT.1) GO TO 20                              ASMG  22
C-------  LIRE UN ELEMENT                                               ASMG  23
      CALL RDELEM(M2,KLOCE,VCORE,VPRNE,VPREE,KNE)                       ASMG  24
C-------  CALCUL DES FONCTIONS D'INTERPOLATION SI NECESSAIRE            ASMG  25
      IF(ITPE.EQ.ITPE1) GO TO 10                                        ASMG  26
      ICOD=2                                                            ASMG  27
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASMG  28
C-------  CALCUL DE LA MATRICE ELEMENTAIRE                              ASMG  29
10    ICOD=5                                                            ASMG  30
      CALL ELEMLB(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                       ASMG  31
C-------  IMPRESSION DE LA MATRICE ELEMENTAIRE                          ASMG  32
      IF(M.LT.2) GO TO 20                                               ASMG  33
      IF(NSYM.EQ.0) IKE=IDLE*(IDLE+1)/2                                 ASMG  34
      IF(NSYM.EQ.1) IKE=IDLE*IDLE                                       ASMG  35
      WRITE(MP,2000) IEL,(VKE(I),I=1,IKE)                               ASMG  36
2000  FORMAT(/' MATRICE (ME) , ELEMENT:',I5/(10X,10E12.5))              ASMG  37
C-------  ASSEMBLAGE                                                    ASMG  38
20    CALL ASSEL(1,0,IDLE,NSYM,KLOCE,KLD,VKE,VFE,VKGS,VKGD,VKGI,VFG)    ASMG  39
30    ITPE1=ITPE                                                        ASMG  40
      RETURN                                                            ASMG  41
      END                                                               ASMG  42
C++++++  FIN FIGURE 6.26
C++++++  DEBUT FIGURE 5.25
      SUBROUTINE JACOBI(VK,VM,N,NCYM,EPS,VALP0,VALP,VECT)               JACI   1
C=======================================================================JACI   2
C     CALCUL DES VALEURS ET VECTEURS PROPRES DE K-LAMBDA.M PAR LA       JACI   3
C     METHODE GENERALE DE JACOBI.                                       JACI   4
C       ENTREES                                                         JACI   5
C         VK       MATRICE K (TRIANGLE SUPERIEUR PAR COLONNES           JACI   6
C                  DESCENDANTES)                                        JACI   7
C         VM       MATRICE M (TRIANGLE SUPERIEUR PAR COLONNES           JACI   8
C                  DESCENDANTES)                                        JACI   9
C         N        DIMENSION DES MATRICES K ET M                        JACI  10
C         NCYM     NOMBRE DE CYCLES MAXIMUM (15)                        JACI  11
C         EPS      PRECISION REQUISE (1.D-12)                           JACI  12
C       TRAVAIL                                                         JACI  13
C         VALP0    TABLE DE TRAVAIL DE DIMENSION N                      JACI  14
C       SORTIES                                                         JACI  15
C         VALP     VALEURS PROPRES                                      JACI  16
C         VECT     VECTEURS PROPRES                                     JACI  17
C=======================================================================JACI  18
      IMPLICIT REAL*8(A-H,O-Z)                                          JACI  19
      COMMON/ES/M,MR,MP                                                 JACI  20
      DIMENSION VK(1),VM(1),VALP0(N),VALP(N),VECT(N,N)                  JACI  21
      DATA EPSD0/1.D-4/,ZERO/0.D0/,UN/1.D0/,DEUX/2.D0/,QUATR/4.D0/      JACI  22
      SQRT(X)=DSQRT(X)                                                  JACI  23
      ABS(X)=DABS(X)                                                    JACI  24
      EPS2=EPS*EPS                                                      JACI  25
      ITR=0                                                             JACI  26
C-------  VERIFIER QUE LES TERMES DIAGONAUX SONT POSITIFS, ET           JACI  27
C         INITIALISER LES VALEURS PROPRES                               JACI  28
      II=0                                                              JACI  29
      DO 20 I=1,N                                                       JACI  30
      II=II+I                                                           JACI  31
      IF(VK(II).GT.ZERO.AND.VM(II).GT.ZERO) GO TO 10                    JACI  32
      WRITE(MP,2000) I                                                  JACI  33
2000  FORMAT(' ** ERREUR, TERME DIAGONAL NEGATIF DANS JACOBI, LIGNE ',  JACI  34
     1  I5)                                                             JACI  35
      STOP                                                              JACI  36
10    VALP(I)=VK(II)/VM(II)                                             JACI  37
20    VALP0(I)=VALP(I)                                                  JACI  38
C-------  INITIALISER LES VECTEURS PROPRES                              JACI  39
      DO 40 I=1,N                                                       JACI  40
      DO 30 J=1,N                                                       JACI  41
30    VECT(I,J)=ZERO                                                    JACI  42
40    VECT(I,I)=UN                                                      JACI  43
C-------  POUR CHAQUE CYCLE                                             JACI  44
      DO 250 IC=1,NCYM                                                  JACI  45
C-------  TOLERANCE DYNAMIQUE                                           JACI  46
      EPSD=EPSD0**IC                                                    JACI  47
C--------  BALAYAGE DU TRIANGLE SUPERIEUR PAR LIGNES                    JACI  48
      IMAX=N-1                                                          JACI  49
       II=0                                                             JACI  50
       DO 180 I=1,IMAX                                                  JACI  51
      I0=II+1                                                           JACI  52
      II=II+I                                                           JACI  53
      IP1=I+1                                                           JACI  54
      IJ=II+I                                                           JACI  55
      JJ=II                                                             JACI  56
      DO 180 J=IP1,N                                                    JACI  57
      JP1=J+1                                                           JACI  58
      JM1=J-1                                                           JACI  59
      J0=JJ+1                                                           JACI  60
      JJ=JJ+J                                                           JACI  61
      J3=JJ-1                                                           JACI  62
C-------  CALCUL DES FACTEURS DE COUPLAGE                               JACI  63
      FK=(VK(IJ)*VK(IJ))/(VK(II)*VK(JJ))                                JACI  64
      FM=(VM(IJ)*VM(IJ))/(VM(II)*VM(JJ))                                JACI  65
      IF(FK.LT.EPSD.AND.FM.LT.EPSD) GO TO 180                           JACI  66
C-------  CALCUL DES COEFFICIENTS DE LA TRANSFORMATION                  JACI  67
      ITR=ITR+1                                                         JACI  68
      C1=VK(II)*VM(IJ)-VM(II)*VK(IJ)                                    JACI  69
      C2=VK(JJ)*VM(IJ)-VM(JJ)*VK(IJ)                                    JACI  70
      C3=VK(II)*VM(JJ)-VM(II)*VK(JJ)                                    JACI  71
      DET=(C3*C3/QUATR)+(C1*C2)                                         JACI  72
      IF(DET.GE.ZERO) GO TO 50                                          JACI  73
      WRITE(MP,2005) I,J                                                JACI  74
2005  FORMAT(' **ERREUR, TRANSFORMATION DE JACOBI SINGULIERE I=',I5,    JACI  75
     1   ' J=',I5)                                                      JACI  76
      STOP                                                              JACI  77
50    DET=SQRT(DET)                                                     JACI  78
      D1=C3/DEUX+DET                                                    JACI  79
      D2=C3/DEUX-DET                                                    JACI  80
      D=D1                                                              JACI  81
      IF(ABS(D2).GT.ABS(D1))D=D2                                        JACI  82
      IF(D.EQ.ZERO) GO TO 60                                            JACI  83
      A=C2/D                                                            JACI  84
      B=-C1/D                                                           JACI  85
      GO TO 65                                                          JACI  86
60    A=ZERO                                                            JACI  87
      B=-VK(IJ)/VK(JJ)                                                  JACI  88
C-------  MODIFIER LES COLONNES DE K ET M                               JACI  89
65    IF(I.EQ.1) GO TO 80                                               JACI  90
      IK=I0                                                             JACI  91
      J1=IJ-1                                                           JACI  92
      DO 70 JK=J0,J1                                                    JACI  93
      C1=VK(IK)                                                         JACI  94
      C2=VK(JK)                                                         JACI  95
      VK(IK)=C1+B*C2                                                    JACI  96
      VK(JK)=C2+A*C1                                                    JACI  97
      C1=VM(IK)                                                         JACI  98
      C2=VM(JK)                                                         JACI  99
      VM(IK)=C1+B*C2                                                    JACI 100
      VM(JK)=C2+A*C1                                                    JACI 101
70    IK=IK+1                                                           JACI 102
80    IF(I.EQ.JM1) GO TO 100                                            JACI 103
      IK=II+I                                                           JACI 104
      J2=IJ+1                                                           JACI 105
      IM=I                                                              JACI 106
      DO 90 JK=J2,J3                                                    JACI 107
      C1=VK(IK)                                                         JACI 108
      C2=VK(JK)                                                         JACI 109
      VK(IK)=C1+B*C2                                                    JACI 110
      VK(JK)=C2+A*C1                                                    JACI 111
      C1=VM(IK)                                                         JACI 112
      C2=VM(JK)                                                         JACI 113
      VM(IK)=C1+B*C2                                                    JACI 114
      VM(JK)=C2+A*C1                                                    JACI 115
      IM=IM+1                                                           JACI 116
90    IK=IK+IM                                                          JACI 117
100   IF(J.EQ.N) GO TO 120                                              JACI 118
      IK=IJ+J                                                           JACI 119
      JK=JJ+J                                                           JACI 120
      IM=J                                                              JACI 121
      DO 110 JJK=JP1,N                                                  JACI 122
      C1=VK(IK)                                                         JACI 123
      C2=VK(JK)                                                         JACI 124
      VK(IK)=C1+B*C2                                                    JACI 125
      VK(JK)=C2+A*C1                                                    JACI 126
      C1=VM(IK)                                                         JACI 127
      C2=VM(JK)                                                         JACI 128
      VM(IK)=C1+B*C2                                                    JACI 129
      VM(JK)=C2+A*C1                                                    JACI 130
      IM=IM+1                                                           JACI 131
      IK=IK+IM                                                          JACI 132
110   JK=JK+IM                                                          JACI 133
120   C1=VK(II)                                                         JACI 134
      C2=VK(IJ)                                                         JACI 135
      C3=VK(JJ)                                                         JACI 136
      B2=B*B                                                            JACI 137
      BB=DEUX*B                                                         JACI 138
      A2=A*A                                                            JACI 139
      AA=DEUX*A                                                         JACI 140
      VK(II)=C1+BB*C2+B2*C3                                             JACI 141
      VK(IJ)=ZERO                                                       JACI 142
      VK(JJ)=C3+AA*C2+A2*C1                                             JACI 143
      C1=VM(II)                                                         JACI 144
      C2=VM(IJ)                                                         JACI 145
      C3=VM(JJ)                                                         JACI 146
      VM(II)=C1+BB*C2+B2*C3                                             JACI 147
      VM(IJ)=ZERO                                                       JACI 148
      VM(JJ)=C3+AA*C2+A2*C1                                             JACI 149
C-------  METTRE A JOUR LES VECTEURS PROPRES                            JACI 150
      DO 170 IJ1=1,N                                                    JACI 151
      C1=VECT(IJ1,I)                                                    JACI 152
      C2=VECT(IJ1,J)                                                    JACI 153
      VECT(IJ1,I)=C1+B*C2                                               JACI 154
170   VECT(IJ1,J)=C2+A*C1                                               JACI 155
180   IJ=IJ+J                                                           JACI 156
C-------  METTRE A JOUR LES VALEURS PROPRES                             JACI 157
      II=0                                                              JACI 158
      DO 190 I=1,N                                                      JACI 159
      II=II+I                                                           JACI 160
      IF(VK(II).GT.ZERO.AND.VM(II).GT.ZERO) GO TO 190                   JACI 161
      WRITE(MP,2000) I                                                  JACI 162
      STOP                                                              JACI 163
190   VALP(I)=VK(II)/VM(II)                                             JACI 164
      IF(M.GT.1) WRITE(MP,2010)IC,(VALP(I),I=1,N)                       JACI 165
2010  FORMAT(/' VALEURS PROPRES, CYCLE ',I4/(1X,10E12.5))               JACI 166
C-------  TEST DE CONVERGENCE DES VALEURS PROPRES                       JACI 167
      DO 200 I=1,N                                                      JACI 168
      IF(ABS(VALP(I)-VALP0(I)).GT.(EPS*VALP0(I))) GO TO 230             JACI 169
200   CONTINUE                                                          JACI 170
C-------  TEST DE CONVERGENCE SUR LES TERMES NON DIAGONAUX              JACI 171
      JJ=1                                                              JACI 172
      DO 210 J=2,N                                                      JACI 173
      JJ=JJ+J                                                           JACI 174
      JM1=J-1                                                           JACI 175
      II=0                                                              JACI 176
      DO 210 I=1,JM1                                                    JACI 177
      II=II+I                                                           JACI 178
      IJ=JJ-J+I                                                         JACI 179
      FK=VK(IJ)*VK(IJ)/(VK(II)*VK(JJ))                                  JACI 180
      FM=VM(IJ)*VM(IJ)/(VM(II)*VM(JJ))                                  JACI 181
      IF(FK.GT.EPS2.OR.FM.GT.EPS2) GO TO 230                            JACI 182
210   CONTINUE                                                          JACI 183
C-------  NORMALISER LES VECTEURS PROPRES                               JACI 184
      JJ=0                                                              JACI 185
      DO 220 J=1,N                                                      JACI 186
      JJ=JJ+J                                                           JACI 187
      C1=SQRT(VM(JJ))                                                   JACI 188
      DO 220 I=1,N                                                      JACI 189
220   VECT(I,J)=VECT(I,J)/C1                                            JACI 190
C-------  CONVERGENCE ATTEINTE                                          JACI 191
      IF(M.GT.0) WRITE(MP,2020) IC,ITR                                  JACI 192
2020  FORMAT(15X,'CONVERGENCE EN ',I4,' CYCLES ET ',I5,' TRANSFORMATIONSJACI 193
     1 DANS JACOBI')                                                    JACI 194
      RETURN                                                            JACI 195
C-------  RECOPIER VALP DANS VALP0                                      JACI 196
230   DO 240 I=1,N                                                      JACI 197
240   VALP0(I)=VALP(I)                                                  JACI 198
250   CONTINUE                                                          JACI 199
C-------  NON CONVERGENCE                                               JACI 200
      WRITE(MP,2030) NCYM                                               JACI 201
2030  FORMAT(' ** ERREUR, NON CONVERGENCE DANS JACOBI EN ',I4,' CYCLES')JACI 202
      STOP                                                              JACI 203
      END                                                               JACI 204
C++++++  FIN FIGURE 5.25
C++++++  DEBUT FIGURE 4.4
      SUBROUTINE ELEM01(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                 EL01   1
C=======================================================================EL01   2
C     ELEMENT QUADRATIQUE POUR LES PROBLEMES HARMONIQUES ANISOTROPES    EL01   3
C       A 1,2 OU 3 DIMENSIONS :                                         EL01   4
C         1 DIMENSION:  ELEMENT A 3 NOEUDS                              EL01   5
C         2 DIMENSIONS: ELEMENT ISO-PARAMETRIQUE A 8 NOEUDS             EL01   6
C         3 DIMENSIONS: ELEMENT ISO-PARAMETRIQUE A 20 NOEUDS            EL01   7
C     NOMBRE DE POINTS D'INTEGRATION : 2 DANS CHAQUE DIRECTION          EL01   8
C     NOMBRE DE DEGRES DE LIBERTE EN CHAQUE NOEUD : 1                   EL01   9
C     MATRICE OU VECTEUR ELEMENTAIRE CONSTRUIT PAR CE SOUS-PROGRAMME    EL01  10
C       SELON LA VALEUR DE ICODE :                                      EL01  11
C          ICODE.EQ.1  RETOUR DES PARAMETRES                            EL01  12
C          ICODE.EQ.2  CALCUL DES FONCTIONS D'INTERPOLATION ET DES      EL01  13
C                      COEFFICIENTS D'INTEGRATION NUMERIQUE             EL01  14
C          ICODE.EQ.3  MATRICE ELEMENTAIRE (VKE)                        EL01  15
C          ICODE.EQ.4  MATRICE TANGENTE (VKE)....PAS ECRIT....          EL01  16
C          ICODE.EQ.5  MATRICE MASSE (VKE)                              EL01  17
C          ICODE.EQ.6  PRODUIT K . U  (VFE)                             EL01  18
C          ICODE.EQ.7  SOLLICITATION ELEMENTAIRE (VFE)....PAS ECRIT.... EL01  19
C          ICODE.EQ.8  IMPRESSION DES GRADIENTS                         EL01  20
C     PROPRIETES ELEMENTAIRES                                           EL01  21
C          VPREE(1)  COEFFICIENT DX                                     EL01  22
C          VPREE(2)  COEFFICIENT DY                                     EL01  23
C          VPREE(3)  COEFFICIENT DZ                                     EL01  24
C          VPREE(4)  CAPACITE SPECIFIQUE DE CHALEUR C                   EL01  25
C=======================================================================EL01  26
      IMPLICIT REAL*8(A-H,O-Z)                                          EL01  27
      COMMON/COOR/NDIM                                                  EL01  28
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGEL01  29
     1  ,ICODE,IDLE0,INEL0,IPG0                                         EL01  30
      COMMON/ES/M,MR,MP                                                 EL01  31
      DIMENSION VCORE(1),VPRNE(1),VPREE(1),VDLE(1),VKE(1),VFE(1)        EL01  32
C.......  DIMENSIONS CARACTERISTIQUES DE L'ELEMENT                      EL01  33
C           (VALABLES JUSQU'A 3 DIMENSIONS)                             EL01  34
C     DIMENSION VCPG(IPG),VKPG(NDIM*IPG),XYZ(NDIM)                      EL01  35
      DIMENSION VCPG(  9),VKPG(      27),XYZ(   3)                      EL01  36
C     DIMENSION VJ (NDIM*NDIM),VJ1(NDIM*NDIM)                           EL01  37
      DIMENSION VJ (        9),VJ1(        9)                           EL01  38
C     DIMENSION VNIX( INEL*NDIM),VNI ((1+NDIM)*INEL*IPG),IPGKED(NDIM)   EL01  39
      DIMENSION VNIX(        60),VNI (             2160),IPGKED(   3)   EL01  40
C         NOMBRE DE P.G. DE SENS KSI,ETA,DZETA                          EL01  41
      DATA IPGKED/3,3,3/                                                EL01  42
C.......                                                                EL01  43
      DATA ZERO/0.D0/,EPS/1.D-6/                                        EL01  44
      IKE=IDLE*(IDLE+1)/2                                               EL01  45
C                                                                       EL01  46
C-------  CHOIX DE LA FONCTION A EXECUTER                               EL01  47
C                                                                       EL01  48
      GO TO (100,200,300,400,500,600,700,800),ICODE                     EL01  49
C                                                                       EL01  50
C-------  RETOUR DES PARAMETRES DE L'ELEMENT DANS LE COMMON 'RGDT'      EL01  51
C                                                                       EL01  52
100   GO TO (110,120,130),NDIM                                          EL01  53
110   IDLE0=3                                                           EL01  54
      INEL0=3                                                           EL01  55
      IPG0=3                                                            EL01  56
      RETURN                                                            EL01  57
120   IDLE0=8                                                           EL01  58
      INEL0=8                                                           EL01  59
      IPG0=9                                                            EL01  60
      RETURN                                                            EL01  61
130   IDLE0=20                                                          EL01  62
      INEL0=20                                                          EL01  63
      IPG0=27                                                           EL01  64
      RETURN                                                            EL01  65
C                                                                       EL01  66
C-------  CALCUL DES COORDONNEES ET POIDS DES P.G.,                     EL01  67
C-------    DES FONCTIONS N ET DE LEURS DERIVEES                        EL01  68
C                                                                       EL01  69
200   CALL GAUSS(IPGKED,NDIM,VKPG,VCPG,IPG)                             EL01  70
      CALL NI01(VKPG,VNI)                                               EL01  71
      RETURN                                                            EL01  72
C                                                                       EL01  73
C-------  CALCUL DE LA MATRICE RIGIDITE ELEMENTAIRE                     EL01  74
C                                                                       EL01  75
C-------  INITIALISER VKE                                               EL01  76
300   DO 310 I=1,IKE                                                    EL01  77
310   VKE(I)=ZERO                                                       EL01  78
C-------  BOUCLE SUR LES POINTS D'INTEGRATION                           EL01  79
      INI=1+INEL                                                        EL01  80
      DO 330 IG=1,IPG                                                   EL01  81
C-------  CALCUL DU JACOBIEN,DE SON INVERSE ET DE SON DETERMINANT       EL01  82
      CALL JACOB(VNI(INI),VCORE,NDIM,INEL,VJ,VJ1,DETJ)                  EL01  83
      IF(DETJ.LT.EPS) WRITE(MP,2000) IEL,IG,DETJ                        EL01  84
2000  FORMAT(' *** ELEM ',I5,' P.G. ',I3,' DET(J)=',E12.5)              EL01  85
C-------   CALCUL DE DETJ*POIDS                                         EL01  86
      COEF=VCPG(IG)*DETJ                                                EL01  87
C-------  CALCUL DES FONCTIONS D(NI)/D(X)                               EL01  88
      CALL DNIDX(VNI(INI),VJ1,NDIM,INEL,VNIX)                           EL01  89
C-------  ACCUMULER LES TERMES DE LA MATRICE ELEMENTAIRE                EL01  90
      IK=0                                                              EL01  91
      DO 320 J=1,IDLE                                                   EL01  92
      DO 320 I=1,J                                                      EL01  93
      I1=I                                                              EL01  94
      I2=J                                                              EL01  95
      C=ZERO                                                            EL01  96
      DO 315 IJ=1,NDIM                                                  EL01  97
      C=C+VNIX(I1)*VNIX(I2)*VPREE(IJ)                                   EL01  98
      I1=I1+IDLE                                                        EL01  99
315   I2=I2+IDLE                                                        EL01 100
      IK=IK+1                                                           EL01 101
320    VKE(IK)=VKE(IK)+C*COEF                                           EL01 102
C-------  PROCHAIN P.G.                                                 EL01 103
330   INI=INI+(NDIM+1)*INEL                                             EL01 104
      RETURN                                                            EL01 105
C                                                                       EL01 106
C-------  CALCUL DE LA MATRICE TANGENTE ELEMENTAIRE                     EL01 107
C                                                                       EL01 108
400   CONTINUE                                                          EL01 109
      RETURN                                                            EL01 110
C                                                                       EL01 111
C-------  MATRICE MASSE                                                 EL01 112
C                                                                       EL01 113
500   DO 510 I=1,IKE                                                    EL01 114
510   VKE(I)=ZERO                                                       EL01 115
      IF(VPREE(4).EQ.ZERO)RETURN                                        EL01 116
      INI=0                                                             EL01 117
      DO 530 IG=1,IPG                                                   EL01 118
C-------  CALCUL DE LA MATRICE JACOBIENNE                               EL01 119
      I1=INI+INEL+1                                                     EL01 120
      CALL JACOB(VNI(I1),VCORE,NDIM,INEL,VJ,VJ1,DETJ)                   EL01 121
C-------  CALCUL DU POIDS                                               EL01 122
      COEF=VCPG(IG)*DETJ*VPREE(4)                                       EL01 123
C-------  TERMES DE LA MATRICE MASSE                                    EL01 124
      IK=0                                                              EL01 125
      DO 520 J=1,IDLE                                                   EL01 126
      DO 520 I=1,J                                                      EL01 127
      IK=IK+1                                                           EL01 128
      I1=INI+I                                                          EL01 129
      I2=INI+J                                                          EL01 130
520   VKE(IK)=VKE(IK)+VNI(I1)*VNI(I2)*COEF                              EL01 131
530   INI=INI+(NDIM+1)*INEL                                             EL01 132
      RETURN                                                            EL01 133
C                                                                       EL01 134
C-------  CALCUL DU RESIDU ELEMENTAIRE                                  EL01 135
C                                                                       EL01 136
600   DO 605 I=1,INEL                                                   EL01 137
605   VFE(I)=ZERO                                                       EL01 138
      INI=1+INEL                                                        EL01 139
      DO 640 IG=1,IPG                                                   EL01 140
C-------  CALCUL DE LA MATRICE JACOBIENNE ET DES DERIVEES DE N EN X,Y,Z EL01 141
      CALL JACOB(VNI(INI),VCORE,NDIM,INEL,VJ,VJ1,DETJ)                  EL01 142
      CALL DNIDX(VNI(INI),VJ1,NDIM,INEL,VNIX)                           EL01 143
C-------   CALCUL DU COEFFICIENT COMMUN                                 EL01 144
      COEF=VCPG(IG)*DETJ                                                EL01 145
C-------  PRODUIT VPREE*B*VDLE                                          EL01 146
      I1=0                                                              EL01 147
      DO 620 I=1,NDIM                                                   EL01 148
      C=ZERO                                                            EL01 149
      DO 610 J=1,INEL                                                   EL01 150
      I1=I1+1                                                           EL01 151
610   C=C+VNIX(I1)*VDLE(J)                                              EL01 152
620   VJ(I)=C*COEF*VPREE(I)                                             EL01 153
C------- PRODUIT (BT)*VJ                                                EL01 154
      DO 630 I=1,INEL                                                   EL01 155
      I1=I-INEL                                                         EL01 156
      DO 630 J=1,NDIM                                                   EL01 157
      I1=I1+INEL                                                        EL01 158
630   VFE(I)=VFE(I)+VNIX(I1)*VJ(J)                                      EL01 159
640   INI=INI+(NDIM+1)*INEL                                             EL01 160
      RETURN                                                            EL01 161
C                                                                       EL01 162
C-------  CALCUL DE FE                                                  EL01 163
C                                                                       EL01 164
700   CONTINUE                                                          EL01 165
      RETURN                                                            EL01 166
C                                                                       EL01 167
C-------  CALCUL ET IMPRESSION DES GRADIENTS AUX P.G.                   EL01 168
C                                                                       EL01 169
800   WRITE(MP,2010) IEL                                                EL01 170
2010  FORMAT(//' GRADIENTS DANS L ELEMENT :',I4//)                      EL01 171
      IDECL=(NDIM+1)*INEL                                               EL01 172
      INI0=1                                                            EL01 173
      INI=1+INEL                                                        EL01 174
      DO 830 IG=1,IPG                                                   EL01 175
      CALL JACOB(VNI(INI),VCORE,NDIM,INEL,VJ,VJ1,DETJ)                  EL01 176
      CALL DNIDX(VNI(INI),VJ1,NDIM,INEL,VNIX)                           EL01 177
C-------  CALCUL DES COORDONNEES DU P.G.                                EL01 178
      DO 803 I=1,NDIM                                                   EL01 179
803   XYZ(I)=ZERO                                                       EL01 180
      IC=1                                                              EL01 181
      I0=INI0                                                           EL01 182
      DO 807 IN=1,INEL                                                  EL01 183
      C=VNI(I0)                                                         EL01 184
      DO 805 I=1,NDIM                                                   EL01 185
      XYZ(I)=XYZ(I)+C*VCORE(IC)                                         EL01 186
805   IC=IC+1                                                           EL01 187
807   I0=I0+1                                                           EL01 188
C-------  CALCUL DU GRADIENT                                            EL01 189
      I1=0                                                              EL01 190
      DO 820 I=1,NDIM                                                   EL01 191
      C=ZERO                                                            EL01 192
      DO 810 J=1,IDLE                                                   EL01 193
      I1=I1+1                                                           EL01 194
810   C=C+VNIX(I1)*VDLE(J)                                              EL01 195
820   VJ(I)=C*VPREE(I)                                                  EL01 196
C-------  IMPRESSION DES GRADIENTS                                      EL01 197
      WRITE(MP,2020) IG,(XYZ(I),I=1,NDIM)                               EL01 198
2020  FORMAT(5X,'P.G. :',I3,' COORDONNEES :',3E12.5)                    EL01 199
      WRITE(MP,2025)(VJ(I),I=1,NDIM)                                    EL01 200
2025  FORMAT(15X,'GRADIENTS   :',3E12.5)                                EL01 201
      INI0=INI0+IDECL                                                   EL01 202
830   INI=INI+IDECL                                                     EL01 203
      WRITE(MP,2030)                                                    EL01 204
2030  FORMAT(//)                                                        EL01 205
      RETURN                                                            EL01 206
      END                                                               EL01 207
                                                                                
      SUBROUTINE NI01(VKPG,VNI)                                         NI01   1
C=======================================================================NI01   2
C     CALCUL DES FONCTIONS D'INTERPOLATION N ET DE LEURS DERIVEES       NI01   3
C     D(N)/D(KSI) D(N)/D(ETA) PAR LA METHODE GENERALE DE PN INVERSE     NI01   4
C     POUR DES ELEMENTS QUADRATIQUES A 1 2 OU 3 DIMENSIONS              NI01   5
C       ENTREES                                                         NI01   6
C          VKPG    COORDONNEES EN LESQUELLES CALCULER  N ...            NI01   7
C          IPG     NOMBRE DE POINTS                                     NI01   8
C          INEL    NOMBRE DE FONCTIONS N  (DE NOEUDS)      INEL.LE.20   NI01   9
C          NDIM    NOMBRE DE DIMENSIONS                    NDIM.LE.3    NI01  10
C       SORTIES                                                         NI01  11
C          VNI     FONCTIONS N ET DERIVEES                              NI01  12
C=======================================================================NI01  13
      IMPLICIT REAL*8(A-H,O-Z)                                          NI01  14
      COMMON/COOR/NDIM                                                  NI01  15
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGNI01  16
      COMMON/TRVL/VKSI,VPN,VP,KEXP,KDER,K1                              NI01  17
      DIMENSION VKPG(1),VNI(1)                                          NI01  18
      DIMENSION VKSI1(3),KEXP1(3),VKSI2(16),KEXP2(16),VKSI3(60),        NI01  19
     1  KEXP3(60)                                                       NI01  20
C                                                                       NI01  21
C.......  INFORMATIONS DEFINISSANT LES 3 ELEMENTS DE REFERENCE          NI01  22
C          (INEL.LE.20  NDIM.LE.3)                                      NI01  23
C     DIMENSION VKSI(NDIM*INEL),KEXP(NDIM*INEL),KDER(NDIM)              NI01  24
      DIMENSION VKSI(       60),KEXP(       60),KDER(   3)              NI01  25
C     DIMENSION VPN (INEL*INEL),VP(INEL)                                NI01  26
      DIMENSION VPN (       400),VP(   20)                              NI01  27
C     DIMENSION K1(INEL)                                                NI01  28
      DIMENSION K1(   20)                                               NI01  29
C         CARACTERISTIQUES DES ELEMENTS DE REFERENCE A 1,2,3 DIM.       NI01  30
      DATA VKSI1/-1.D0,0.D0,1.D0/,KEXP1/0,1,2/                          NI01  31
      DATA VKSI2/-1.D0,-1.D0, +0.D0,-1.D0, +1.D0,-1.D0, +1.D0,+0.D0,    NI01  32
     1           +1.D0,+1.D0, +0.D0,+1.D0, -1.D0,+1.D0, -1.D0,+0.D0/    NI01  33
      DATA KEXP2/0,0, 1,0, 0,1, 2,0, 1,1, 0,2, 2,1, 1,2/,IDEGR/2/       NI01  34
      DATA VKSI3/-1.D0,-1.D0,-1.D0, +0.D0,-1.D0,-1.D0,                  NI01  35
     1           +1.D0,-1.D0,-1.D0, +1.D0,+0.D0,-1.D0,                  NI01  36
     2           +1.D0,+1.D0,-1.D0, +0.D0,+1.D0,-1.D0,                  NI01  37
     3           -1.D0,+1.D0,-1.D0, -1.D0,+0.D0,-1.D0,                  NI01  38
     4           -1.D0,-1.D0,+0.D0, +1.D0,-1.D0,+0.D0,                  NI01  39
     5           +1.D0,+1.D0,+0.D0, -1.D0,+1.D0,+0.D0,                  NI01  40
     6           -1.D0,-1.D0,+1.D0, +0.D0,-1.D0,+1.D0,                  NI01  41
     7           +1.D0,-1.D0,+1.D0, +1.D0,+0.D0,+1.D0,                  NI01  42
     8           +1.D0,+1.D0,+1.D0, +0.D0,+1.D0,+1.D0,                  NI01  43
     9           -1.D0,+1.D0,+1.D0, -1.D0,+0.D0,+1.D0/                  NI01  44
      DATA KEXP3/0,0,0, 1,0,0, 0,1,0, 0,0,1, 1,1,1,                     NI01  45
     1  1,1,0, 0,1,1, 1,0,1, 2,0,0, 0,2,0, 0,0,2,                       NI01  46
     2  2,1,0, 2,0,1, 2,1,1, 1,2,0, 0,2,1, 1,2,1,                       NI01  47
     3  1,0,2, 0,1,2, 1,1,2/                                            NI01  48
C                                                                       NI01  49
C.......                                                                NI01  50
      IDEG=IDEGR                                                        NI01  51
C-------  SELECTIONNER LES TABLES VKSI ET KEXP SELON NDIM               NI01  52
      I1=NDIM*INEL                                                      NI01  53
      DO 5 I=1,I1                                                       NI01  54
      GO TO (1,2,3),NDIM                                                NI01  55
1     VKSI(I)=VKSI1(I)                                                  NI01  56
      KEXP(I)=KEXP1(I)                                                  NI01  57
      GO TO 5                                                           NI01  58
2     VKSI(I)=VKSI2(I)                                                  NI01  59
      KEXP(I)=KEXP2(I)                                                  NI01  60
      GO TO 5                                                           NI01  61
3     VKSI(I)=VKSI3(I)                                                  NI01  62
      KEXP(I)=KEXP3(I)                                                  NI01  63
5     CONTINUE                                                          NI01  64
C-------  CALCUL DE LA MATRICE PN INVERSE                               NI01  65
      CALL PNINV(VKSI,KEXP,VP,K1,VPN)                                   NI01  66
C-------  CALCUL DE N,D(N)/D(KSI),D(N)/D(ETA) AUX P.G.                  NI01  67
      I1=1                                                              NI01  68
      I2=1                                                              NI01  69
      DO 10 IG=1,IPG                                                    NI01  70
      KDER(1)=0                                                         NI01  71
      KDER(2)=0                                                         NI01  72
      KDER(3)=0                                                         NI01  73
      CALL NI(VKPG(I1),KEXP,KDER,VP,VPN,VNI(I2))                        NI01  74
      I2=I2+INEL                                                        NI01  75
      KDER(1)=1                                                         NI01  76
      CALL NI(VKPG(I1),KEXP,KDER,VP,VPN,VNI(I2))                        NI01  77
      I2=I2+INEL                                                        NI01  78
      IF(NDIM.EQ.1) GO TO 10                                            NI01  79
      KDER(1)=0                                                         NI01  80
      KDER(2)=1                                                         NI01  81
      CALL NI(VKPG(I1),KEXP,KDER,VP,VPN,VNI(I2))                        NI01  82
      I2=I2+INEL                                                        NI01  83
      IF(NDIM.EQ.2) GO TO 10                                            NI01  84
      KDER(2)=0                                                         NI01  85
      KDER(3)=1                                                         NI01  86
      CALL NI(VKPG(I1),KEXP,KDER,VP,VPN,VNI(I2))                        NI01  87
      I2=I2+INEL                                                        NI01  88
10    I1=I1+NDIM                                                        NI01  89
      RETURN                                                            NI01  90
      END                                                               NI01  91
C++++++  FIN FIGURE 4.4
C++++++  DEBUT FIGURE 4.5
      SUBROUTINE ELEM02(VCORE,VPRNE,VPREE,VDLE,VKE,VFE)                 EL02   1
C=======================================================================EL02   2
C     ELEMENT QUADRATIQUE A 8 NOEUDS POUR L'ELASTICITE A 2 DIMENSIONS   EL02   3
C          CALCUL DES INFORMATIONS ELEMENTAIRES SELON LA VALEUR DE ICODEEL02   4
C          ICODE=1  PARAMETRES DE L'ELEMENT                             EL02   5
C          ICODE=2  FONCTIONS D'INTERPOLATION ET COEFFICIENTS DE GAUSS  EL02   6
C          ICODE=3  MATRICE RIGIDITE                                    EL02   7
C          ICODE=4  MATRICE TANGENTE  ... PAS ECRIT ...                 EL02   8
C          ICODE=5  MATRICE MASSE                                       EL02   9
C          ICODE=6  RESIDUS                                             EL02  10
C          ICODE=7  SECOND MEMBRE                                       EL02  11
C          ICODE=8  CALCUL ET IMPRESSION DES CONTRAINTES                EL02  12
C       PROPRIETES ELEMENTAIRES                                         EL02  13
C          VPREE(1)  MODULE D'YOUNG                                     EL02  14
C          VPREE(2)  COEFFICIENT DE POISSON                             EL02  15
C          VPREE(3)  .EQ.0  CONTRAINTES PLANES                          EL02  16
C                    .EQ.1  DEFORMATIONS PLANES                         EL02  17
C          VPREE(4)  MASSE SPECIFIQUE                                   EL02  18
C=======================================================================EL02  19
      IMPLICIT REAL*8(A-H,O-Z)                                          EL02  20
      COMMON/COOR/NDIM                                                  EL02  21
      COMMON/ASSE/NSYM                                                  EL02  22
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGEL02  23
     1  ,ICODE,IDLE0,INEL0,IPG0                                         EL02  24
      COMMON/ES/M,MR,MP                                                 EL02  25
      DIMENSION VCORE(1),VPRNE(1),VPREE(1),VDLE(1),VKE(1),VFE(1)        EL02  26
C.......  DIMENSIONS CARACTERISTIQUES DE L'ELEMENT                      EL02  27
C     DIMENSION VCPG(      IPG),VKPG(NDIM*IPG),VDE1(IMATD**2)           EL02  28
      DIMENSION VCPG(        9),VKPG(      18),VDE1(       9)           EL02  29
C     DIMENSION VBE (IMATD*IDLE),VDE (IMATD**2),VJ (NDIM*NDIM),VJ1(NDIM*EL02  30
      DIMENSION VBE (       48),VDE (       9),VJ (        4),VJ1(4)    EL02  31
C     DIMENSION VNIX( INEL*NDIM),VNI ((1+NDIM)*INEL*IPG),IPGKED(NDIM)   EL02  32
      DIMENSION VNIX(        16),VNI (              216),IPGKED(   2)   EL02  33
C         DIMENSION DE LA MATRICE D,NOMBRE DE P.G.                      EL02  34
      DATA IMATD/3/,IPGKED/3,3/                                         EL02  35
C.......                                                                EL02  36
      DATA ZERO/0.D0/,DEUX/2.D0/,X05/0.5D0/,RADN/.572957795130823D2/    EL02  37
      DATA EPS/1.D-6/                                                   EL02  38
      SQRT(X)=DSQRT(X)                                                  EL02  39
      ATAN2(X,Y)=DATAN2(X,Y)                                            EL02  40
C                                                                       EL02  41
C-------  CHOIX DE LA FONCTION A EXECUTER                               EL02  42
C                                                                       EL02  43
      GO TO (100,200,300,400,500,600,700,800),ICODE                     EL02  44
C                                                                       EL02  45
C-------  RETOUR DES PARAMETRES DE L'ELEMENT DANS COMMON 'RGDT'         EL02  46
C                                                                       EL02  47
100   IDLE0=16                                                          EL02  48
      INEL0=8                                                           EL02  49
      IPG0=9                                                            EL02  50
C     RETURN                                                            EL02  51
C                                                                       EL02  52
C-------  CALCUL DES COORDONNEES ET POIDS DE P.G., ET DES FONCTIONS N ETEL02  53
C-------  DE LEURS DERIVEES.                                            EL02  54
C                                                                       EL02  55
200   CALL GAUSS(IPGKED,NDIM,VKPG,VCPG,IPG)                             EL02  56
      IF(M.LT.2) GO TO 220                                              EL02  57
      WRITE(MP,2000) IPG                                                EL02  58
2000  FORMAT(/I5,'  POINTS DE GAUSS'/10X,'VCPG',25X,'VKPG')             EL02  59
      I0=1                                                              EL02  60
      DO 210 IG=1,IPG                                                   EL02  61
      I1=I0+NDIM-1                                                      EL02  62
      WRITE(MP,2010) VCPG(IG),(VKPG(I),I=I0,I1)                         EL02  63
210   I0=I0+NDIM                                                        EL02  64
2010  FORMAT(1X,F20.15,5X,3F20.15)                                      EL02  65
220   CALL NI02(VKPG,VNI)                                               EL02  66
      IF(M.LT.2) RETURN                                                 EL02  67
      I1=3*INEL*IPG                                                     EL02  68
      WRITE(MP,2020) (VNI(I),I=1,I1)                                    EL02  69
2020  FORMAT(/' FONCTIONS N ET DERIVEES'/ (1X,8E12.5))                  EL02  70
      RETURN                                                            EL02  71
C                                                                       EL02  72
C-------  CALCUL DE LA MATRICE RIGIDITE ELEMENTAIRE                     EL02  73
C                                                                       EL02  74
C-------  INITIALISER VKE                                               EL02  75
300   DO 310 I=1,136                                                    EL02  76
310   VKE(I)=ZERO                                                       EL02  77
C-------  CALCUL DE D                                                   EL02  78
      CALL D02(VPREE,VDE)                                               EL02  79
      IF(M.GE.2) WRITE(MP,2030) (VDE(I),I=1,9)                          EL02  80
2030  FORMAT(/' MATRICE D'/1X,9E12.5)                                   EL02  81
C-------  BOUCLE SUR LES P.G.                                           EL02  82
      I1=1+INEL                                                         EL02  83
      DO 330 IG=1,IPG                                                   EL02  84
C-------  CALCUL DU JACOBIEN,DE SON INVERSE ET DE SON DETERMINANT       EL02  85
      CALL JACOB(VNI(I1),VCORE,NDIM,INEL,VJ,VJ1,DETJ)                   EL02  86
      IF(DETJ.LT.EPS) WRITE(MP,2040) IEL,IG,DETJ                        EL02  87
2040  FORMAT(' *** ELEM ',I5,' P.G. ',I3,' DET(J)=',E12.5)              EL02  88
      IF(M.GE.2) WRITE(MP,2050) VJ,VJ1,DETJ                             EL02  89
2050  FORMAT(/' JACOBIEN=',4E12.5 / ' J INVERS=',4E12.5/' DETJ=',E12.5) EL02  90
C-------  CALCUL DE D*COEF                                              EL02  91
      C=VCPG(IG)*DETJ                                                   EL02  92
      DO 320 I=1,9                                                      EL02  93
320   VDE1(I)=VDE(I)*C                                                  EL02  94
C-------  CALCUL DE B                                                   EL02  95
      CALL DNIDX(VNI(I1),VJ1,NDIM,INEL,VNIX)                            EL02  96
      IF(M.GE.2) WRITE(MP,2060) (VNIX(I),I=1,16)                        EL02  97
2060  FORMAT(/' VNIX'/(1X,8E12.5))                                      EL02  98
      CALL B02(VNIX,INEL,VBE)                                           EL02  99
      IF(M.GE.2) WRITE(MP,2070) (VBE(I),I=1,48)                         EL02 100
2070  FORMAT(/' MATRICE B'/(1X,10E12.5))                                EL02 101
      CALL BTDB(VKE,VBE,VDE1,IDLE,IMATD,NSYM)                           EL02 102
330   I1=I1+3*INEL                                                      EL02 103
      RETURN                                                            EL02 104
C                                                                       EL02 105
C-------  CALCUL DE LA MATRICE TANGENTE ELEMENTAIRE                     EL02 106
C                                                                       EL02 107
400   CONTINUE                                                          EL02 108
      RETURN                                                            EL02 109
C                                                                       EL02 110
C-------  CALCUL DE LA MATRICE MASSE                                    EL02 111
C                                                                       EL02 112
500   DO 510 I=1,136                                                    EL02 113
510   VKE(I)=ZERO                                                       EL02 114
C-------  BOUCLE SUR LES P.G.                                           EL02 115
      IDIM1=NDIM-1                                                      EL02 116
      IDECL=(NDIM+1)*INEL                                               EL02 117
      I1=1+INEL                                                         EL02 118
      I2=0                                                              EL02 119
      DO 550 IG=1,IPG                                                   EL02 120
      CALL JACOB(VNI(I1),VCORE,NDIM,INEL,VJ,VJ1,DETJ)                   EL02 121
      D=VCPG(IG)*DETJ*VPREE(4)                                          EL02 122
C-------  ACCUMULER LES TERMES DE MASSE                                 EL02 123
      IDL=0                                                             EL02 124
      DO 540 J=1,INEL                                                   EL02 125
      JJ=I2+J                                                           EL02 126
      J0=1+IDL*(IDL+1)/2                                                EL02 127
      DO 530 I=1,J                                                      EL02 128
      II=I2+I                                                           EL02 129
      C=VNI(II)*VNI(JJ)*D                                               EL02 130
      VKE(J0)=VKE(J0)+C                                                 EL02 131
      IF(NDIM.EQ.1) GO TO 530                                           EL02 132
      J1=J0+IDL+2                                                       EL02 133
      DO 520 II=1,IDIM1                                                 EL02 134
      VKE(J1)=VKE(J1)+C                                                 EL02 135
520   J1=J1+J1+1                                                        EL02 136
530   J0=J0+NDIM                                                        EL02 137
540   IDL=IDL+NDIM                                                      EL02 138
      I1=I1+IDECL                                                       EL02 139
550   I2=I2+IDECL                                                       EL02 140
      RETURN                                                            EL02 141
C                                                                       EL02 142
C-------  CALCUL DU RESIDU ELEMENTAIRE                                  EL02 143
C                                                                       EL02 144
C-------  CALCUL DE LA MATRICE D                                        EL02 145
600   CALL D02(VPREE,VDE)                                               EL02 146
C-------  INITIALISER LE VECTEUR DES RESIDUS                            EL02 147
      DO 610 ID=1,IDLE                                                  EL02 148
610   VFE(ID)=ZERO                                                      EL02 149
C-------  BOUCLE SUR LES P.G.                                           EL02 150
      I1=1+INEL                                                         EL02 151
      DO 640 IG=1,IPG                                                   EL02 152
C-------  CALCUL DU JACOBIEN                                            EL02 153
      CALL JACOB(VNI(I1),VCORE,NDIM,INEL,VJ,VJ1,DETJ)                   EL02 154
C-------  CALCUL DES FONCTIONS D(NI)/D(X)                               EL02 155
      CALL DNIDX(VNI(I1),VJ1,NDIM,INEL,VNIX)                            EL02 156
C-------  CALCUL DES DEFORMATIONS ET CONTRAINTES                        EL02 157
      EPSX=ZERO                                                         EL02 158
      EPSY=ZERO                                                         EL02 159
      GAMXY=ZERO                                                        EL02 160
      ID=1                                                              EL02 161
      DO 620 IN=1,INEL                                                  EL02 162
      UN=VDLE(ID)                                                       EL02 163
      VN=VDLE(ID+1)                                                     EL02 164
      C1=VNIX(IN)                                                       EL02 165
      IN1=IN+INEL                                                       EL02 166
      C2=VNIX(IN1)                                                      EL02 167
      EPSX=EPSX+C1*UN                                                   EL02 168
      EPSY=EPSY+C2*VN                                                   EL02 169
      GAMXY=GAMXY+C1*VN+C2*UN                                           EL02 170
620   ID=ID+2                                                           EL02 171
      C1=VCPG(IG)*DETJ                                                  EL02 172
      C2=VDE(2)*C1                                                      EL02 173
      C3=VDE(9)*C1                                                      EL02 174
      C1=VDE(1)*C1                                                      EL02 175
      SIGX=C1*EPSX+C2*EPSY                                              EL02 176
      SIGY=C2*EPSX+C1*EPSY                                              EL02 177
      TAUXY=C3*GAMXY                                                    EL02 178
C-------  CALCUL DU RESIDU                                              EL02 179
      ID=1                                                              EL02 180
      DO 630 IN=1,INEL                                                  EL02 181
      C1=VNIX(IN)                                                       EL02 182
      IN1=IN+INEL                                                       EL02 183
      C2=VNIX(IN1)                                                      EL02 184
      VFE(ID)=VFE(ID)+C1*SIGX+C2*TAUXY                                  EL02 185
      VFE(ID+1)=VFE(ID+1)+C2*SIGY+C1*TAUXY                              EL02 186
630   ID=ID+2                                                           EL02 187
640   I1=I1+3*INEL                                                      EL02 188
      RETURN                                                            EL02 189
C                                                                       EL02 190
C-------  CALCUL DES FORCES DE VOLUME, FX FY PAR UNITE DE VOLUME        EL02 191
C         ( POUR LA GRAVITE FX=0 FY=-VPREE(4) )                         EL02 192
C                                                                       EL02 193
700   FX=ZERO                                                           EL02 194
      FY=-VPREE(4)                                                      EL02 195
      DO 710 I=1,16                                                     EL02 196
710   VFE(I)=ZERO                                                       EL02 197
      I1=1                                                              EL02 198
      IDECL=(NDIM+1)*INEL                                               EL02 199
      DO 730 IG=1,IPG                                                   EL02 200
      CALL JACOB(VNI(I1+INEL),VCORE,NDIM,INEL,VJ,VJ1,DETJ)              EL02 201
      DX=VCPG(IG)*DETJ                                                  EL02 202
      DY=DX*FY                                                          EL02 203
      DX=DX*FX                                                          EL02 204
      I2=I1                                                             EL02 205
      I3=1                                                              EL02 206
      DO 720 IN=1,INEL                                                  EL02 207
      VFE(I3)=VFE(I3)+DX*VNI(I2)                                        EL02 208
      VFE(I3+1)=VFE(I3+1)+DY*VNI(I2)                                    EL02 209
      I2=I2+1                                                           EL02 210
720   I3=I3+2                                                           EL02 211
730   I1=I1+IDECL                                                       EL02 212
      RETURN                                                            EL02 213
C                                                                       EL02 214
C-------  CALCUL ET IMPRESSION DES CONTRAINTES AUX P.G.                 EL02 215
C                                                                       EL02 216
800   WRITE(MP,2080) IEL                                                EL02 217
2080  FORMAT(//' CONTRAINTES DANS L ELEMENT ',I5/                       EL02 218
     1 '  P.G.',7X,'X',11X,'Y',9X,'EPSX',8X,'EPSY',7X,'GAMXY',8X,'SIGX',EL02 219
     2 8X,'SIGY',7X,'TAUXY',8X,'TETA'/ 71X ,'SIG1',8X,'SIG2',7X,'TAUMAX'EL02 220
     3 /)                                                               EL02 221
C-------  CALCUL DE LA MATRICE D                                        EL02 222
      CALL D02(VPREE,VDE)                                               EL02 223
C-------  BOUCLE SUR LES P.G.                                           EL02 224
      I1=1+INEL                                                         EL02 225
      I2=0                                                              EL02 226
      DO 820 IG=1,IPG                                                   EL02 227
C-------  CALCUL DU JACOBIEN                                            EL02 228
      CALL JACOB(VNI(I1),VCORE,NDIM,INEL,VJ,VJ1,DETJ)                   EL02 229
C-------  CALCUL DES FONCTIONS D(NI)/D(X)                               EL02 230
      CALL DNIDX(VNI(I1),VJ1,NDIM,INEL,VNIX)                            EL02 231
C-------  CALCUL DES DEFORMATIONS ET COORDONNEES DU P.G.                EL02 232
      EPSX=ZERO                                                         EL02 233
      EPSY=ZERO                                                         EL02 234
      GAMXY=ZERO                                                        EL02 235
      X=ZERO                                                            EL02 236
      Y=ZERO                                                            EL02 237
      ID=1                                                              EL02 238
      DO 810 IN=1,INEL                                                  EL02 239
      UN=VDLE(ID)                                                       EL02 240
      VN=VDLE(ID+1)                                                     EL02 241
      XN=VCORE(ID)                                                      EL02 242
      YN=VCORE(ID+1)                                                    EL02 243
      C1=VNIX(IN)                                                       EL02 244
      IN1=IN+INEL                                                       EL02 245
      C2=VNIX(IN1)                                                      EL02 246
      IN1=IN+I2                                                         EL02 247
      C3=VNI(IN1)                                                       EL02 248
      EPSX=EPSX+C1*UN                                                   EL02 249
      EPSY=EPSY+C2*VN                                                   EL02 250
      GAMXY=GAMXY+C1*VN+C2*UN                                           EL02 251
      X=X+C3*XN                                                         EL02 252
      Y=Y+C3*YN                                                         EL02 253
810   ID=ID+2                                                           EL02 254
C-------  CALCUL DES CONTRAINTES                                        EL02 255
      SIGX=VDE(1)*EPSX+VDE(2)*EPSY                                      EL02 256
      SIGY=VDE(2)*EPSX+VDE(1)*EPSY                                      EL02 257
      TAUXY=VDE(9)*GAMXY                                                EL02 258
C-------  CALCUL DES CONTRAINTES PRINCIPALES                            EL02 259
      TETA=ATAN2(DEUX*TAUXY,SIGX-SIGY)*X05                              EL02 260
      TETA=TETA*RADN                                                    EL02 261
      C1=(SIGX+SIGY)*X05                                                EL02 262
      C2=(SIGX-SIGY)*X05                                                EL02 263
      TAUMAX=SQRT(C2*C2+TAUXY*TAUXY)                                    EL02 264
      SIG1=C1+TAUMAX                                                    EL02 265
      SIG2=C1-TAUMAX                                                    EL02 266
      WRITE(MP,2090) IG,X,Y,EPSX,EPSY,GAMXY,SIGX,SIGY,TAUXY,            EL02 267
     1  TETA,SIG1,SIG2,TAUMAX                                           EL02 268
2090  FORMAT(1X,I5,8E12.5,5X,F5.1/66X,3E12.5)                           EL02 269
      I2=I2+3*INEL                                                      EL02 270
820   I1=I1+3*INEL                                                      EL02 271
      RETURN                                                            EL02 272
      END                                                               EL02 273
                                                                                
      SUBROUTINE NI02(VKPG,VNI)                                         NI02   1
C=======================================================================NI02   2
C     CALCUL DES FONCTIONS D'INTERPOLATION N ET DE LEURS DERIVEES       NI02   3
C     D(N)/D(KSI) ET D(N)/D(ETA) PAR LA METHODE GENERALE DE PN INVERSE  NI02   4
C       ENTREES                                                         NI02   5
C          VKPG    COORDONNEES EN LESQUELLES CALCULER  N ...            NI02   6
C          IPG     NOMBRE DE POINTS                                     NI02   7
C          INEL    NOMBRE DE FONCTIONS N  (DE NOEUDS)      INEL.EQ.8    NI02   8
C          NDIM    NOMBRE DE DIMENSIONS                    NDIM.EQ.2    NI02   9
C       SORTIE                                                          NI02  10
C          VNI     FONCTIONS N ET DERIVEES                              NI02  11
C=======================================================================NI02  12
      IMPLICIT REAL*8(A-H,O-Z)                                          NI02  13
      COMMON/COOR/NDIM                                                  NI02  14
      COMMON/RGDT/IEL,ITPE,ITPE1,IGRE,IDLE,ICE,IPRNE,IPREE,INEL,IDEG,IPGNI02  15
      DIMENSION VKPG(1),VNI(1)                                          NI02  16
C                                                                       NI02  17
C.......  INFORMATIONS LIEES A L'ELEMENT DE REFERENCE CARRE A 8 NOEUDS  NI02  18
C          (INEL.EQ.8  NDIM.EQ.2)                                       NI02  19
C     DIMENSION VKSI(NDIM*INEL),KEXP(NDIM*INEL),KDER(NDIM)              NI02  20
      DIMENSION VKSI(       16),KEXP(       16),KDER(   2)              NI02  21
C     DIMENSION VPN (INEL*INEL),VP(INEL),K1(INEL)                       NI02  22
      DIMENSION VPN (       64),VP(   8),K1(   8)                       NI02  23
C         COORDONNEES DES NOEUDS DE L'ELEMENT DE REFERENCE              NI02  24
      DATA VKSI/-1.D0,-1.D0, +0.D0,-1.D0, +1.D0,-1.D0, +1.D0,+0.D0,     NI02  25
     1          +1.D0,+1.D0, +0.D0,+1.D0, -1.D0,+1.D0, -1.D0,+0.D0/     NI02  26
C         EXPOSANTS DES MONOMES DE LA BASE POLYNOMIALE,DEGRE MAX.       NI02  27
      DATA KEXP/0,0, 1,0, 0,1, 2,0, 1,1, 0,2, 2,1, 1,2/,IDEGR/2/        NI02  28
C                                                                       NI02  29
C.......                                                                NI02  30
      IDEG=IDEGR                                                        NI02  31
C-------  CALCUL DE LA MATRICE PN INVERSE                               NI02  32
      CALL PNINV(VKSI,KEXP,VP,K1,VPN)                                   NI02  33
C-------  CALCUL DE N,D(N)/D(KSI),D(N)/D(ETA) AUX P.G.                  NI02  34
      I1=1                                                              NI02  35
      I2=1                                                              NI02  36
      DO 10 IG=1,IPG                                                    NI02  37
      KDER(1)=0                                                         NI02  38
      KDER(2)=0                                                         NI02  39
      CALL NI(VKPG(I1),KEXP,KDER,VP,VPN,VNI(I2))                        NI02  40
      I2=I2+INEL                                                        NI02  41
      KDER(1)=1                                                         NI02  42
      CALL NI(VKPG(I1),KEXP,KDER,VP,VPN,VNI(I2))                        NI02  43
      I2=I2+INEL                                                        NI02  44
      KDER(1)=0                                                         NI02  45
      KDER(2)=1                                                         NI02  46
      CALL NI(VKPG(I1),KEXP,KDER,VP,VPN,VNI(I2))                        NI02  47
      I2=I2+INEL                                                        NI02  48
10    I1=I1+NDIM                                                        NI02  49
      RETURN                                                            NI02  50
      END                                                               NI02  51
                                                                                
      SUBROUTINE D02(VPREE,VDE)                                         D02    1
C=======================================================================D02    2
C     CONSTRUCTION DE LA MATRICE D (ELASTICITE A 2 DIMENSIONS)          D02    3
C        ENTREES                                                        D02    4
C          VPREE   PROPRIETES ELEMENTAIRES                              D02    5
C                       VPREE(1)   MODULE D'YOUNG                       D02    6
C                       VPREE(2)   COEFFICIENT DE POISSON               D02    7
C                       VPREE(3)  .EQ.0  CONTRAINTES PLANES             D02    8
C                                 .EQ.1  DEFORMATIONS PLANES            D02    9
C        SORTIES                                                        D02   10
C          VDE     MATRICE D (PLEINE)                                   D02   11
C=======================================================================D02   12
      IMPLICIT REAL*8(A-H,O-Z)                                          D02   13
      DIMENSION VPREE(1),VDE(9)                                         D02   14
      DATA ZERO/0.D0/,UN/1.D0/,DEUX/2.D0/                               D02   15
      E=VPREE(1)                                                        D02   16
      X=VPREE(2)                                                        D02   17
      A=VPREE(3)                                                        D02   18
      C1=E*(UN-A*X)/((UN+X)*(UN-X-A*X))                                 D02   19
      C2=C1*X/(UN-A*X)                                                  D02   20
      C3=E/(DEUX*(UN+X))                                                D02   21
      VDE(1)=C1                                                         D02   22
      VDE(2)=C2                                                         D02   23
      VDE(3)=ZERO                                                       D02   24
      VDE(4)=C2                                                         D02   25
      VDE(5)=C1                                                         D02   26
      VDE(6)=ZERO                                                       D02   27
      VDE(7)=ZERO                                                       D02   28
      VDE(8)=ZERO                                                       D02   29
      VDE(9)=C3                                                         D02   30
      RETURN                                                            D02   31
      END                                                               D02   32
                                                                                
      SUBROUTINE B02(VNIX,INEL,VBE)                                     B02    1
C=======================================================================B02    2
C     CONSTRUCTION DE LA MATRICE B (ELASTICITE A 2 DIMENSIONS)          B02    3
C        ENTREES                                                        B02    4
C          VNIX    DERIVEES DES FONCTIONS D'INTERPOLATION EN X,Y,Z      B02    5
C          INEL    NOMBRE DE FONCTIONS D'INTERPOLATION                  B02    6
C        SORTIE                                                         B02    7
C          VBE     MATRICE B                                            B02    8
C=======================================================================B02    9
      IMPLICIT REAL*8(A-H,O-Z)                                          B02   10
      DIMENSION VNIX(INEL,1),VBE(3,1)                                   B02   11
      DATA ZERO/0.D0/                                                   B02   12
      J=1                                                               B02   13
      DO 10 I=1,INEL                                                    B02   14
      C1=VNIX(I,1)                                                      B02   15
      C2=VNIX(I,2)                                                      B02   16
      VBE(1,J)=C1                                                       B02   17
      VBE(1,J+1)=ZERO                                                   B02   18
      VBE(2,J)=ZERO                                                     B02   19
      VBE(2,J+1)=C2                                                     B02   20
      VBE(3,J)=C2                                                       B02   21
      VBE(3,J+1)=C1                                                     B02   22
10    J=J+2                                                             B02   23
      RETURN                                                            B02   24
      END                                                               B02   25
                                                                                
      SUBROUTINE BTDB(VKE,VBE,VDE,IDLE,IMATD,NSYM)                      BTDB   1
C=======================================================================BTDB   2
C     AJOUTE LE PRODUIT B(T).D.B  A  VKE                                BTDB   3
C        ENTREES                                                        BTDB   4
C          VKE     MATRICE ELEMENTAIRE NON SYMETRIQUE  (NSYM.EQ.1)      BTDB   5
C                                      SYMETRIQUE      (NSYM.EQ.0)      BTDB   6
C          VBE     MATRICE B                                            BTDB   7
C          VDE     MATRICE D (PLEINE)                                   BTDB   8
C          IDLE    NOMBRE TOTAL DE D.L. DE L'ELEMENT                    BTDB   9
C          IMATD   DIMENSION DE LA MATRICE D  (MAX. 6)                  BTDB  10
C        SORTIE                                                         BTDB  11
C          VKE                                                          BTDB  12
C=======================================================================BTDB  13
      IMPLICIT REAL*8(A-H,O-Z)                                          BTDB  14
      DIMENSION VKE(1),VBE(IMATD,1),VDE(IMATD,1),T(6)                   BTDB  15
      DATA ZERO/0.D0/                                                   BTDB  16
C-----------------------------------------------------------------------BTDB  17
      IJ=1                                                              BTDB  18
      IMAX=IDLE                                                         BTDB  19
      DO 40 J=1,IDLE                                                    BTDB  20
      DO 20 I1=1,IMATD                                                  BTDB  21
      C=ZERO                                                            BTDB  22
      DO 10 J1=1,IMATD                                                  BTDB  23
10    C=C+VDE(I1,J1)*VBE(J1,J)                                          BTDB  24
20    T(I1)=C                                                           BTDB  25
      IF(NSYM.EQ.0) IMAX=J                                              BTDB  26
      DO 40 I=1,IMAX                                                    BTDB  27
      C=ZERO                                                            BTDB  28
      DO 30 J1=1,IMATD                                                  BTDB  29
30    C=C+VBE(J1,I)*T(J1)                                               BTDB  30
      VKE(IJ)=VKE(IJ)+C                                                 BTDB  31
40    IJ=IJ+1                                                           BTDB  32
      RETURN                                                            BTDB  33
      END                                                               BTDB  34
C++++++  FIN FIGURE 4.5
      SUBROUTINE ELEM03
      ENTRY ELEM04
      RETURN
      ENTRY ELEM05
      RETURN
      ENTRY ELEM06
      RETURN
      ENTRY ELEM07
      RETURN
      ENTRY ELEM08
      RETURN
      ENTRY ELEM09
      RETURN
      ENTRY ELEM10
      RETURN
      END
