[updated 8.Sep.2008]

Qui appelle calkef ?

      SUBROUTINE CALKEF

  Auteurs : D.Martin & O.deBayser (Avril 1988) 
  Derniere modification : D.Martin &C.Chambeyron (13 novembre 2002)
  Version 1.0.7
 
  Calcul Elements Finis sur tous les domaines
 
  Numerotations globales sur les domaine de calcul             (NUMNIV, NUMDOM)
  Calculs geometriques (coordonnees des noeuds & normales)             (CALGEO)
  Tableaux de Compactage morse sur les domaines de calcul 
                                               (DSKNIV, DSKBMO, DSKMLI, DSKMCO)
  Determination des termes a calcul sur le domaine                     (TRMDOM)
  Calculs des termes 'VALeurs NODales' et 'Condition ESSEntielle'      (VNQLTR)
                                   et 'Condition de TRANsmission'
  Calcul des matrices 'ELements FINIs' sur les domaines de calcul      (EFQLTR)
  Calcul des termes 'E.F.Localises' par integration numeriQUe          (EFQLTR)
  Sauvegarde des termes calcules sur le domaine                        (SAVTRM) 

      IMPLICIT NONE
      INCLUDE 'ALLOC'
      INCLUDE 'CONTEX'
 
      CHARACTER     ERCODE*120,PRFXAS*8
      CHARACTER     KALTEF,KALTME,KALTQU,KALTIT,KALTVN,KALTCE,KALTPC
      INTEGER       PTXQUA
      INTEGER       ADDOMK,ADDOM1,DOMAIN
     &             ,MCTRDO,LGERDO,NBDOMK,INCRDO,NCHDOM
     &             ,MCDTRM,LGETRM,NBTERM,INCTRM,NCHTRM
     &             ,MCDOMK,NUDOMG,NUDOMK,IGEOME,INDMIX,NUSCHQ,INDEXC
     &             ,IDLHRC,INTRPC,NBNECX,NBNEXC,NBDLXC,NBNFXC,NBDFXC
     &             ,NVNUMC,INDEXL,IDLHRL,INTRPL,NBNELX,NBNEXL,NBDLXL
     &             ,NBNFXL,NBDFXL,NVNUML,NVCORC,INUTIL,NBTRDO,NIVDOM
     &             ,MCLIST,NXLIST,LGRPTL,NDMDOM,NDMDOE,NBELDO
     &             ,NBNEXG,NBDLXG,NBNFXG,NBDFXG,NUCC,NUCL,NULC,NULL
     &             ,NBNECO,NBNELI,NUDGAV,NIVALL,MCNOMD,NBPTQX
      INTEGER       ITYSYD,ICORNE,ICORNW,IRPLOC,DIMOBL,DIMOBU,DIMORL
     &             ,DIMORC,DIMATE,DIVECC,DIVECL,NVSTKB,NVSTKL,NVSTKC
      COMMON/FORMAH/ERCODE

      CALL PRFXMJ (1,'*CalkEF*')
 
      CALL TBAR2  (ERCODE,'#TERDO',1,MCTRDO,'$SDTRM',1,MCDTRM)
      CALL SDEXDB (IST(MCTRDO),LGERDO,NBDOMK,INCRDO,NCHDOM)             !utilite
      CALL SDEXDB (IST(MCDTRM),LGETRM,NBTERM,INCTRM,NCHTRM)             !utilite
      ADDOMK=LGERDO
      ADDOM1=ADDOMK
      NUDGAV=0
                          +++++++++++++++++++++++++++++
                          ++ BOUCLE SUR LES DOMAINES ++
                          +++++++++++++++++++++++++++++
                             DO 1000 DOMAIN=1,NBDOMK
 
      ERCODE=' '
      CALL TBAR1  (ERCODE,'#TERDO',1,MCTRDO)                     
   
      Exploitation du contenu de la structure de donnees #TERDO
      pour le domaine de calcul NUDOMK
 
      ADDOMK adresse relative (-1) du domaine de calcul courant dans #TERDO  
      ADDOM1 adresse relative (-1) du premier domaine de calcul dans #TERDO
             attache au domaine geometrique courant
      MCDOMK adresse absolue des caracteristiques du domaine courant
      MCDOMK=MCTRDO+ADDOMK
   
      Recherche des parametres de description du domaine de calcul 
      CALL GETDOM (IST(MCDOMK),NUDOMG,NUDOMK,IGEOME,INDMIX,NUSCHQ
     &            ,INDEXC,IDLHRC,INTRPC,NBNECX,NBNEXC,NBDLXC,NBNFXC
     &            ,NBDFXC,NVNUMC
     &            ,INDEXL,IDLHRL,INTRPL,NBNELX,NBNEXL,NBDLXL,NBNFXL
     &            ,NBDFXL,NVNUML,NVCORC,INUTIL,NBTRDO,NIVDOM)           !sdexplo
 
      IF (NUDOMG.NE.NUDGAV) ADDOM1=ADDOMK
      NUDGAV=NUDOMG
      NIVALL=NVNUMC
      DIMATE=-99999
 
      INDMIX negatif ou nul indique qu'aucun terme n'est a (re)calculer
      IGEOME negatif ou nul indique qu'aucun calcul geometrique n'est demande
 
      IF (INDMIX.GT.0.OR.IGEOME.GT.0) THEN
 
         Exploitation de la structure de donnees #ISTEL (1ere partie) 
         (Renseignements globaux sur les elements constituant le domaine)
         CALL TBRR2  (ERCODE,'#ISTEL',NUDOMG,MCLIST
     &                      ,'#ORPTL',NUDOMK,LGRPTL)
         CALL TBAR1  (ERCODE,'#ISTEL',NUDOMG,MCLIST)
         NDMDOM dimension des constituants du domaine
         NDMDOE dimension des elements support des elements du domaine
         NBELDO nombre de constituants du domaine
         NB..XG nombre maximum de noeuds, d.l. dans un element ou un bord
         CALL EXLIST (IST(MCLIST),NXLIST,NDMDOM,NDMDOE,NBELDO
     &               ,NBNEXG,NBDLXG,NBNFXG,NBDFXG)                      !sdexplo
 
 Ce test semble INUTILE mais demande une verification
 
         IF (NDMDOM.GE.0) THEN
 
            Nom du domaine geometrique NUDOMG correspondant au domaine 
            de calcul NUDOMK
            IF (NIVDOM.GE.0) THEN
               CALL TBAR1  (ERCODE,'#OMDOM',1,MCNOMD)
               CALL PRNOMD (AST(MCNOMD+(NUDOMG-1)*NCHDOM),NCHDOM,NUDOMK
     &                     ,NDMDOM,NBELDO,NBTRDO,IGEOME,NUSCHQ,INTRPG
     &                     ,INTRPC,INTRPL,NIVDOM,IMPPAL,IMPSDR)         !caldom
            ENDIF
   
            Tableaux de numerotation des noeuds
            #GNEDO liste des numeros globaux des noeuds du domaine
            #RGNDO rangs des noeuds des elements du domaine dans #GNEDO
 
            IF (ADDOMK.GT.ADDOM1)
     &      CALL NUMNIV (ADDOMK,ADDOM1,INCRDO,NUDOMK,INTRPC,INDEXC
     &                  ,INTRPL,INDEXL,NVNUMC,NVNUML
     &                  ,NUCC,NUCL,NULC,NULL,NIVDOM,IMPSDR)             !caldom
 
            CALL NUMDOM (NDMDOM,NDMDOE,NBELDO,NXLIST,ADDOMK,NUDOMK
     &                  ,NBNECO,NVNUMC,NBNELI,NVNUML,NIVALL,IMPSDR)     !caldom
 
            IF (IGEOME.GT.0) THEN
 
               Calcul des normales pour l'interpolation en colonne 
               tableau (&NORMA,NVNUMC)
 
               IRPLOC=MOD(IGEOME,10)
               IF (NDMDOM.NE.NDIM-1) IRPLOC=0
               NVCORC=NVNUMC
 
               et coordonnees des noeuds pour l'interpolation en colonne
               tableau (&CORNE,NVNUMC)
 
               ICORNE=ABS(IGEOME)/10
               ICORNW=ICORNE
               Traitement special du cas INTRPC = 0 sur un bord
               IF (NDMDOM.EQ.NDMDOE.OR.INTRPC.GT.0) ICORNW=0
 
               CALL CALGEO (NDMDOM,NDMDOE,NUDOMG,NUDOMK,NCHDOM,NBELDO
     &                     ,NXLIST,'Col',INTRPC,MAX(INDEXC,INDEXL)
     &                     ,NBNFXC,NBNECO,IRPLOC,ICORNW,NVCORC,NVCORC
     &                     ,NIVDOM)                                     !caldom
 
               Calcul conserve pour des raisons de compatibilite
               Les coordonnees des noeuds sur le domaine sont extraites
               du tableau global des coordonnees des noeuds (#ORNOE,INTRPC)
 
               IF (ICORNE.GT.0.AND.ICORNW.EQ.0) THEN
                  CALL CRCOOR (INTRPC,NVNUMC,NVCORC,NIVDOM)
               ENDIF
            ENDIF
 
            Les calculs sur le domaine n'ont pas ete redemande ... on s'casse
            IF (INDMIX.GT.0.AND.NBTRDO.GE.1) THEN  
   
               CALL TBAR2  (ERCODE,'#TERDO',1,MCTRDO,'$SDTRM',1,MCDTRM)
   
               Tableaux de stockage des matrices pre-assemblees
 
               NVSTKB=0
               NVSTKL=0
               NVSTKC=0
               ITYSYD=1
               CALL DSKNIV (NBTRDO,IST(MCTRDO+ADDOMK+INCRDO),INCTRM
     &                     ,IST(MCDTRM+LGETRM),NIVALL,NVSTKB,NVSTKL
     &                     ,NVSTKC,ITYSYD)                              !caltrm
 
               DIMOBL=0
               DIMOBU=0
               IF (NVSTKB.NE.0)
     &            CALL DSKBMO (NCHDOM,NUDOMG,NUDOMK,NBELDO,NBNECO,NBNELI
     &                        ,ABS(NVSTKB),ITYSYD,DIMOBL,DIMOBU
     &                        ,NIVDOM,IMPSDR)                           !caltrm
               NVSTKB=ABS(NVSTKB)
 
               DIMORL=0
               IF (NVSTKL.NE.0)
     &            CALL DSKMLI (NCHDOM,NUDOMG,NUDOMK,NBELDO,NBNECO,NBNELI
     &                        ,ABS(NVSTKL),DIMORL,NIVDOM,IMPSDR)        !caltrm
               NVSTKL=ABS(NVSTKL)
 
               DIMORC=0
               IF (NVSTKC.NE.0)
     &            CALL DSKMCO (NCHDOM,NUDOMG,NUDOMK,NBELDO,NBNECO,NBNELI 
     &                        ,ABS(NVSTKC),DIMORC,NIVDOM,IMPSDR)        !caltrm
               NVSTKC=ABS(NVSTKC)
               IF (DIMATE.LE.0)
     &         CALL DSKMLM (NUDOMK,NBELDO,DIMATE,DIVECC,DIVECL)         !caltrm
          call chrono('Tables de compactage',imppal)
   
               Creation des tableaux 'Elements Finis' sur le domaine
               -----------------------------------------------------
               CALL TRMDOM (NBTRDO,INCRDO,ADDOMK,NBNECO,NBNELI,NVNUMC
     &                     ,NVNUML,NIVALL,NVCORC,DIMOBL,DIMOBU,DIMORL
     &                     ,DIMORC,DIMATE,DIVECC,DIVECL
     &                     ,KALTEF,KALTME,KALTQU,KALTIT,KALTPC,KALTVN
     &                     ,KALTCE)                                     !caltrm
 
               Termes 'Valeurs Nodales' ou 'Condition Essentielle'
 
               IF (KALTVN.EQ.'Y'.OR.KALTCE.EQ.'Y')
     &            CALL VNQLTR (NBTRDO,ADDOMK+INCRDO,INTRPC,NBNECO
     &                        ,NVNUMC,NVCORC,IMPSDR)                    !caltrm
 
               Termes 'ELEMENTS FINIS'
 
               IF (KALTEF.EQ.'Y'.OR.KALTME.EQ.'Y'.OR.KALTQU.EQ.'Y') THEN
 
                 Test du degre de la formule de quadrature sur le domaine
 
                 CALL CHKQUA (NUSCHQ,NDMDOM,INTRPC,INTRPL,IMPPAL,IMPMES)!ef3d
 
                 NBPTQX majore le nombre de points de quadrature sur le domaine
 
                 NBPTQX=PTXQUA (NUSCHQ,NDMDOM)                          !ef3d
 
                 CALL EFQLTR (NDMDOM,NDMDOE,NBELDO,NXLIST,INCRDO,ADDOMK
     &                       ,NBTRDO,NBPTQX,NBDLXG,NBDFXG,NVNUMC,NVNUML
     &                       ,NVSTKB,NVSTKL,NVSTKC,KALTEF,KALTME,KALTQU        
     &                       ,IMPSDR)                                   !caltrm
 
                 IF (KALTEF.EQ.'Y') CALL SAVTRM ('ELFINI',ADDOMK,IMPSDR)!caldom
                 IF (KALTME.EQ.'Y') CALL SAVTRM ('MATELM',ADDOMK,IMPSDR)!caldom
                 IF (KALTQU.EQ.'Y') CALL SAVTRM ('ELFLQU',ADDOMK,IMPSDR)!caldom
 
                
               ENDIF
 vvvvvvvvvv Supprime le 12 Octobre 2000 (jamais utilise) vvvvvvvvvvvvvvvvvvvvvvv
 *              Termes 'INTERPOLATION' (?)
 
                IF (KALTIT.EQ.'Y') THEN
      &           CALL ITQLTR (NDMDOM,NDMDOE,NBELDO,NXLIST,INCRDO,ADDOMK
      &                       ,NBTRDO,NBDLXG,NBDFXG,NVNUMC,NVNUML,IMPSDR)!calkit
                  CALL SAVTRM ('INTERP',ADDOMK,IMPSDR)                   !caldom
                ENDIF
 
 *              Termes 'FORME LINEAIRE' en un point (?)
 
                IF (KALTPC.EQ.'Y') THEN
                  CALL PCQLTR (NDMDOM,NDMDOE,NBELDO,NXLIST,INCRDO,ADDOMK
      &                       ,NBTRDO,NBDLXG,NBDFXG,NVNUMC,NVNUML,NVSTKB
      &                       ,NVSTKL,NVSTKC,IMPSDR)                     !calkpc
                  CALL SAVTRM ('FORMLI',ADDOMK,IMPSDR)                   !caldom
                ENDIF
 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 
               Sauvegarde des termes 'Valeurs Nodales'
 
               IF (KALTVN.EQ.'Y') CALL SAVTRM ('VALNOD',ADDOMK,IMPSDR)  !caldom
 
               Sauvegarde des termes 'CONDITION ESSENTIELLE'
 
               IF (KALTCE.EQ.'Y') CALL SAVTRM ('C.ESSE',ADDOMK,IMPSDR)  !caldom
 
               Sauvegarde des termes 'CONDITION DE TRANSMISSION'
 
               IF (KALTCE.EQ.'Y') CALL SAVTRM ('C.TRAN',ADDOMK,IMPSDR)  !caldom
 
            ENDIF
   
            Sauvegarde des tableaux de numerotations 
            ----------------------------------------
            CALL TBSAVE ('#RGNDO',NUDOMK)
            IF (NVNUMC.NE.NDFNUM) CALL TBSAVE ('#GNEDO',NVNUMC)
            IF (NVNUML.NE.NDFNUM.AND.NVNUML.NE.NVNUMC)
     &         CALL TBSAVE ('#GNEDO',NVNUML)                     
 
            Mise a jour des parametres de description du domaine de calcul
            --------------------------------------------------------------
            CALL TBAR1  (ERCODE,'#TERDO',1,MCTRDO)
            IGEOME=-ABS(IGEOME)
            INDMIX=-ABS(INDMIX)
            MCDOMK=MCTRDO+ADDOMK
            CALL PUTDOM (IST(MCDOMK),NUDOMG,NUDOMK,IGEOME,INDMIX,NUSCHQ
     &            ,INDEXC,IDLHRC,INTRPC,NBNECX,NBNEXC,NBDLXC,NBNFXC
     &            ,NBDFXC,NVNUMC
     &            ,INDEXL,IDLHRL,INTRPL,NBNELX,NBNEXL,NBDLXL,NBNFXL
     &            ,NBDFXL,NVNUML,NVCORC,INUTIL,NBTRDO,NIVDOM)           !sdexplo
 
            IF (NIVDOM.GT.5) CALL PRTRDO (NUDOMG,NUDOMK,IMPSDR)         !psrsd
            IF (NIVDOM.GT.0) WRITE (IMPSDR,10000)
 
         ELSE
 
            Pour depister un cas incongru
 
            CALL WARNNG ('Cas NDMDOM < 0 rencontre!')
         ENDIF
 **         call chrono('calcul ef',imppal)
 
         Sauvegarde du tableau de definition et des coordonnees des points
         -----------------------------------------------------------------
         CALL TBSAVE ('#ISTEL',NUDOMG)
         CALL TBSAVE ('#ORPTL',NUDOMK)
 
      ENDIF 
 
1000  ADDOMK=ADDOMK+INCRDO+NBTRDO  
      CALL PRFXMJ (-1,'*CalkEF*')

10000 FORMAT(T2,'Fin des calculs sur le domaine',/T2,30('='),/)
                                                                    END !CalkEF

calkef est appelé dans (31 procédures)