[updated 8.Sep.2008]

Librairie couplag > Fichier cogdno.f

Qui appelle cogdno ?

line
      SUBROUTINE COGDNO (KPERSO,KLNOYO,NMGDNS,NVGDNS,NMGDND,NVGDND
     &                  ,NIVIMP)
line
  Auteur : D.Martin (Juin 1995)
  Derniere modification D.Martin (7 Mai 1999)
   
  Calcul, pour les termes de COuplage elements finis/representation integrale,
                             --
  des produits GDelta * NOyau.
               --       --
   
 -- Arguments d'entree -- 
  KPERSO ='STANDARD' formulation standard
         =<Autre chose> indique que les calculs Gdelta *  Noyau sont effectues 
         a l'aide d'une routine PRSOGN fournie par l'utilisateur
  KLNOYO type de noyau ('DIRichlet', 'NEUmann' ou 'FOUrier') 
         argument utile seulement si les noyaux n'existent pas  
  NMGDNS nom du produit Gdelta*Noyau pour le potentiel de simple couche :
                      = Gdelta_{i,l} * G (P_k,M_l)
         (peut etre la chaine blanche ' ')
  NVGDNS son niveau (si NMGDNS n'est pas ' '), ignore sinon
  NMGDND nom du produit Gdelta*Noyau pour le potentiel de douche couche :
                      = Gdelta_{i,l} * dG/dnP (P_k,M_l)
         (peut etre la chaine blanche ' ')
  NVGDND son niveau (si NMGSND n'est pas ' '), ignore sinon
  NIVIMP niveau d'impression des termes de couplage
 
 -- Tableaux de travail utilises --
  $WORK$ / 2 tableau COMPLEXE des valeurs des constantes associees 
             a la fonction de Green 
 
 -- Structure $GDNOY
  1  numero du domaine Sigma de couplage
  2  numero du domaine Gamma de representation integrale
  3  numero de l'inconnue en ligne de Gdelta et du resultat
  4  numero de l'inconnue en colonne de Gdelta et en ligne de la matrice noyau
  5  numero de l'inconnue en colonne de la matrice noyau (en ligne de Pdelta)
  6  numero de l'inconnue en colonne de la matrice Pdelta
  7  numero de terme de la matrice Gdelta, le cas echeant
  8  numero de type (REEL ou COMPLEXE) de la matrice Gdelta
  9  numero de terme de la matrice Pdelta, le cas echeant
  10 numero de type (REEL ou COMPLEXE) de la matrice Pdelta
  11 numero de donnee de la constante Lambda, le cas echeant
  12 numero de type (REEL ou COMPLEXE) de la fonction de Green
  13 niveau de la matrice Noyau de simple couche de nom 'NoyauS', le cas echeant
  14 niveau de la matrice Noyau de simple couche de nom 'NoyauD', le cas echeant
  15 nombre de donnees necessaires pour les calculs de Green
  15+i numero de la i-eme donnee associee
line
      CHARACTER*(*) KPERSO,KLNOYO,NMGDNS,NMGDND
      INTEGER       NVGDNS,NVGDND,NIVIMP
   
      INCLUDE 'CONTEX' 
      INCLUDE 'ALLOC'  
 
      CHARACTER*1   NOYAUX,NOEGAM,NOESIG,NORGAM,NORSIG
      CHARACTER     TYPINT*4                                            !utilite
      CHARACTER     TYGDNO*4,TYTBAS*4,NMTBAS*6,NMINCO*16,NMGDEL*16
      CHARACTER     ERCODE*120,CALCUL*6
      INTEGER       INDSTO,INDSYM,KLTERM,INTTYP,INTYKL                  !utilite
      INTEGER       LAMBDE,NVTBAS,ADDONA
      REAL          LAMBDR
      COMPLEX       LAMBDC
      LOGICAL       CRETRM
      COMMON/FORMAH/ERCODE
      EQUIVALENCE  (LAMBDE,LAMBDR,LAMBDC)
      PARAMETER    (ADDONA=15)
line
      CALL PRFXMJ (1,'*CoGdNo*')
      ITREEL=INTTYP ('REEL')                                            !utilite
      ITCOMP=INTTYP ('COMPLEXE')                                        !utilite
 
      Recherche de la structure '$GDNOY' de cosntruction des termes
 
      CALL TBAR2  (ERCODE,'#OMTRM',1,MCMTRM,'$SDTRM',1,MCDTRM)          !utilite
      CALL SDEXDB (IST(MCDTRM),LGETRM,NBTERM,INCTRM,NCHTRM)             !sdexplo
      NUSGGD=NDFDSM
      IF (NMGDNS.NE.' ') THEN
         NUGDNS=KLTERM (NMGDNS,NVGDNS,AST(MCMTRM),IST(MCDTRM))          !sdexplo
         IF (NUGDNS.LE.0) CALL ERTERM(1,NMGDNS,NVGDNS)
         CALL GETTRM (IST(MCDTRM+LGETRM+INCTRM*(NUGDNS-1)) 
     &               ,NIVEAU,ITGDNO,ITYCAL,NUK,NUD,ITS,NUSGGD
     &               ,NUC,NDC,NBNC,NVC,NUL,NDL,NBNL,NVL
     &               ,IND,NVS,NVCO,IN3,NIV)                             !sdexplo
      ENDIF
      NUSGG2=NDFDSM
      IF (NMGDND.NE.' ') THEN
         NUGDND=KLTERM (NMGDND,NVGDND,AST(MCMTRM),IST(MCDTRM))          !sdexplo
         IF (NUGDND.LE.0) CALL ERTERM(1,NMGDND,NVGDND)
         CALL GETTRM (IST(MCDTRM+LGETRM+INCTRM*(NUGDND-1)) 
     &               ,NIVEAU,ITGDNO,ITYCAL,NUK,NUD,ITS,NUSGG2
     &               ,NUC,NDC,NBNC,NVC,NUL,NDL,NBNL,NVL
     &               ,IND,NVS,NVCO,IN3,NIV)                             !sdexplo
      ENDIF
      IF (NUSGGD.EQ.NDFDSM) THEN
          NUSGGD=NUSGG2
      ELSEIF (NUSGG2.NE.NDFDSM.AND.NUSGGD.NE.NUSGG2) THEN
         GOTO 99990
      ENDIF
      IF (NUSGGD.EQ.NDFDSM) GOTO 99994
 
      Contenu de la structure $GDNOY de niveau NUSGGD (voir plus haut)
      CALL TBRR1  (ERCODE,'$GDNOY',NUSGGD,MCSDGN)
      CALL TBAR1  (ERCODE,'$GDNOY',NUSGGD,MCSDGN)
      NUDKSI=IST(MCSDGN)
      NUDKGA=IST(MCSDGN+1)
      INCOGL=IST(MCSDGN+2)
      INCOGC=IST(MCSDGN+3)
      INCOPL=IST(MCSDGN+4)
      INCOPC=IST(MCSDGN+5)
      NUGDEL=IST(MCSDGN+6)
      ITGDEL=IST(MCSDGN+7)
      NUPDEL=IST(MCSDGN+8)
      ITPDEL=IST(MCSDGN+9)
      NULAMB=IST(MCSDGN+10)
      ITFGRE=IST(MCSDGN+11)
      NVNOYS=IST(MCSDGN+12)
      NVNOYD=IST(MCSDGN+13)
      NBDONG=IST(MCSDGN+ADDONA-1)
      IF (NIVIMP.GT.3) CALL PRSDGN (NUSGGD,IMPSDR)                      !Prsd
 
      ITNOYO=ITFGRE
      LGWOR2=0
 
        NOYAUX='Y' les noyaux de Green globaux existent, ils ont ete
                   calcules par appel a CALNOY (Calgre)
      NOYAUX='N'
      IF (NMGDNS.NE.' '.AND.NVNOYS.NE.NDFNDF) NOYAUX='Y'
      IF (NMGDND.NE.' '.AND.NVNOYD.NE.NDFNDF) NOYAUX='Y'
      IF (NOYAUX.EQ.'N') THEN
 
         Les noyaux de Green n'ont pas ete calcules prealablement
 --      Recherche de la constante de couplage Lambda (cas KLNOYO='FOUrier')
         Sa valeur est placee dans la variable LAMBDC complexe quelque soit
         le type de la donnee constante LAMBDA
         LAMBDC=0.
         IF (KLNOYO(1:3).EQ.'FOU')  THEN
            CALL TBAR1  (ERCODE,'$DONNE',1,MCDONN)
            CALL SDEXCO (NULAMB,IST(MCDONN),ITYDON,NUCSTE,ITLAMB)       !sdexplo
            CALL OUTCST (NUCSTE,ITLAMB,LAMBDE,LAMBDR,LAMBDC,ERCODE)     !sdexplo
            IF (ITLAMB.EQ.ITCOMP) ITNOYO=ITCOMP
         ENDIF
 
 --      Recherche des donnees associees au calcul de la fonction de Green.
         Les valeurs des constantes sont placees dans le tableau $WORK$ 2
         de type complexe, dans l'ordre ou elles sont declarees.
         LGWOR2=MAX (1,NBDONG)
         CALL TBCREE ('$WORK$',2,ITCOMP,LGWOR2,'c')
         NMTBAS=' '
         NVTBAS=NDFNDF
         TYTBAS=' '
         IF (NBDONG.GT.0) CALL COCOGR (NBDONG,IST(MCSDGN+ADDONA)
     &                               ,'$WORK$',2,NMTBAS,NVTBAS,TYTBAS)  !couplag
      ELSE
 
          Les noyaux de Green ont ete calcules prealablement et 
          trouvent dans les tableaux 'NoyauS',NVNOYS et 'NoyauD',NVNOYD
         IF (NVNOYS.NE.NDFNDF) CALL TBTYPE ('NoyauS',NVNOYS,ITNOYO)
         IF (NVNOYD.NE.NDFNDF) CALL TBTYPE ('NoyauD',NVNOYD,ITNOYO)
      ENDIF
 
      CALL TBAR1  (ERCODE,'#TERDO',1,MCTRDO)                     
      CALL SDEXDB (IST(MCTRDO),LGERDO,NBDOMK,INCRDO,NCHDOM)             !sdexplo
 
 --   Adresse dans la structure #TERDO des domaines Sigma et Gamma
      NBTRDO=0
      NDEBDO=MCTRDO+LGERDO
      DO 10 NUDOMK=1,MIN(NUDKGA,NUDKSI)
         NBTRDO=IST(NDEBDO+INCRDO-2)
         NDEBDO=NDEBDO+INCRDO+NBTRDO
10    CONTINUE
      IATRGA=NDEBDO-(MCTRDO+INCRDO+NBTRDO)
      DO 11 NUDOMK=MIN(NUDKGA,NUDKSI)+1,MAX(NUDKGA,NUDKSI)
         NBTRDO=IST(NDEBDO+INCRDO-2)
         NDEBDO=NDEBDO+INCRDO+NBTRDO
11    CONTINUE
      IATRSI=NDEBDO-(MCTRDO+INCRDO+NBTRDO)
      IF (NUDKGA.GT.NUDKSI) THEN
         IATR=IATRSI
         IATRSI=IATRGA
         IATRGA=IATR
      ENDIF
 
      Attributs de Sigma, domaine de couplage et 
                de Gamma, domaine de representation integrale
      CALL GETDOM (IST(MCTRDO+IATRSI)  ,NUDGSI,NWDKSI,IGEOME,INDMIX
     &            ,NUSCHQ,INDEXC,IDLHRC,INTRSC,NBNECX,NBNEEX,NBDLEX
     &            ,NBNEFX,NBDLFX,NVNCSI,INDEXL,IDLHRL,INTRSL,NBNELX
     &            ,NBNEEY,NBDLEY,NBNEFY,NBDLFY,NVNLSI,NVCOSI,INUTIL
     &            ,NBTRDO,NIVDOM)                                       !sdexplo
      CALL GETDOM (IST(MCTRDO+IATRGA)  ,NUDGGA,NWDKGA,IGEOME,INDMIX
     &            ,NUSCHQ,INDEXC,IDLHRC,INTRGC,NBNECX,NBNEEX,NBDLEX
     &            ,NBNEFX,NBDLFX,NVNCGA,INDEXL,IDLHRL,INTRGL,NBNELX
     &            ,NBNEEY,NBDLEY,NBNEFY,NBDLFY,NVNLGA,NVCOGA,INUTIL
     &            ,NBTRDO,NIVDOM)                                       !sdexplo
 
 --   Inconnues en ligne et colonne sur Sigma, inconnue en ligne sur Gamma
      CALL TBAR2  (ERCODE,'#OMINC',1,MCMINC,'#NCONU',1,MCCONU)
      CALL SDEXDB (IST(MCCONU),LGEINC,NBINCO,INCINC,NCHINC)             !sdexplo
 
      CALL SDEXCO (INCOGL,IST(MCCONU),NCPIGL,INTIGL,NBTNEU)             !sdexplo
      IF (NCPIGL.GT.1) CALL ERINCO (2,NMINCO(1:NCHINC))                 !utilite
      IF (INTIGL.LE.0) CALL ERINCO (4,NMINCO(1:NCHINC))                 !utilite
      CALL SDEXCO (INCOGC,IST(MCCONU),NCPIGC,INTIGC,NBTNEU)             !sdexplo
      IF (NCPIGC.GT.1) CALL ERINCO (2,NMINCO(1:NCHINC))                 !utilite
      IF (INTIGC.LE.0) CALL ERINCO (4,NMINCO(1:NCHINC))                 !utilite
      CALL SDEXCO (INCOPL,IST(MCCONU),NCPIPL,INTIPL,NBTNEU)             !sdexplo
      IF (NCPIPL.GT.1) CALL ERINCO (2,NMINCO(1:NCHINC))                 !utilite
      IF (INTIPL.LE.0) CALL ERINCO (4,NMINCO(1:NCHINC))                 !utilite
 
      NMGDEL=' '
      ITYCGD=INTYKL ('NONDEF')                                          !utilite
      IF (NUGDEL.GT.0) THEN
 
 --      Le cas echeant, attributs du terme Gdelta defini sur Sigma
         CALL TBAR2  (ERCODE,'#OMTRM',1,MCMTRM,'$SDTRM',1,MCDTRM)
         CALL SDEXDB (IST(MCDTRM),LGETRM,NBTERM,INCTRM,NCHTRM)          !sdexplo
 
         CALL GETCHN (AST(MCMTRM),NCHTRM,NUGDEL,NMGDEL)                 !utilite
         CALL GETTRM (IST(MCDTRM+LGETRM+INCTRM*(NUGDEL-1))
     &               ,NVGDEL,ITGDEL,ITYCGD,NUKALE,NUDONN,ITYSYG,IPTDIR
     &               ,INCWGC,NVDUCG,KOGDEL,NVNUCG,INCWGL,NVDULG,LIGDEL
     &               ,NVNULG,INDSTG,NVNUSG,NVCOGD,IATRGD,NIVIGD)        !sdexplo
         NVNLGN=NVNULG
         CALL TBRR2  (ERCODE,NMGDEL(1:NCHTRM),NVGDEL,MCGDEL
     &                      ,'#GNEDO',NVNCSI,MCNCSI)
         IF (NVNLSI.NE.NVNCSI) 
     &      CALL TBRR1 (ERCODE,'#GNEDO',NVNLSI,MCNLSI)
         CALL TBAR1  (ERCODE,'#GNEDO',NVNCSI,MCNCSI)
         MCNLSI=MCNCSI
         IF (NVNLSI.NE.NVNCSI) 
     &      CALL TBAR1 (ERCODE,'#GNEDO',NVNLSI,MCNLSI)
         IF (KOGDEL.NE.IST(MCNCSI+1)) GOTO 99991
 
      ELSE
         NVNLGN=NVNLSI
         CALL TBRR1  (ERCODE,'#GNEDO',NVNCSI,MCNCSI)
         IF (NVNLSI.NE.NVNCSI)
     &      CALL TBRR1  (ERCODE,'#GNEDO',NVNLSI,MCNLSI)
         CALL TBAR1  (ERCODE,'#GNEDO',NVNCSI,MCNCSI)
         MCNLSI=MCNCSI
         IF (NVNLSI.NE.NVNCSI) 
     &      CALL TBAR1 (ERCODE,'#GNEDO',NVNLSI,MCNLSI)
         LIGDEL=IST(MCNLSI+1)
         KOGDEL=IST(MCNCSI+1)
 
      ENDIF
 
      IF (NVNLSI.NE.NVNCSI) CALL TBSAVE ('#GNEDO',NVNLSI)
 
      CALCUL='local' calculs locaux (element par element sur Sigma)
      CALCUL='global' calculs globaux sur Sigma
      CALCUL=' '
      NOEGAM='N'
      NORGAM='N'
      NOESIG='N'
      NORSIG='N'
      IF (NUGDEL.LE.0.OR.ITYCGD.EQ.INTYKL ('MATELM'))  THEN             !utilite
         NOEGAM='Y'
         CALCUL='local '
      ELSE IF (NUGDEL.GT.0) THEN
         CALCUL='global'
      ENDIF
      IF (NOYAUX.EQ.'N') THEN
         NOEGAM='Y'
         IF (NMGDND.NE.' ') NORGAM='Y'
         IF (KLNOYO(1:3).NE.'DIR'.AND.CALCUL.EQ.'global') NORSIG='Y'
      ENDIF
      NOESIG=NOEGAM
      CALL TBRR1  (ERCODE,'#GNEDO',NVNLGA,MCNLGA)
      CALL TBAR1  (ERCODE,'#GNEDO',NVNLGA,MCNLGA)
      LIPDEL=IST(MCNLGA+1)
 
      NVNOGA=0
      IF (NORGAM.EQ.'Y') THEN
 
 --      Tableau &NORMA (normales assemblees aux noeuds) sur Gamma
               pour le cas des noyaux de Double couche
         NOTE : A l'avenir on aura besoin des composantes aux noeuds
                pour l'inconnue en LIGNE sur Gamma
         NVNOGA=NVCOGA
         CALL TBRR1  (ERCODE,'&NORMA',NVNOGA,MCNOGA)
         IF (INTRGL.NE.INTRGC) GOTO 99992
         IF (MCNOGA.NE.NDIM*LIPDEL) GOTO 99993
      ENDIF
      NVNOSI=0
      IF (NORSIG.EQ.'Y') THEN
 --      Tableau &NORMA (normales assemblees aux noeuds) sur Sigma
         NVNOSI=NVCOSI
         CALL TBRR1  (ERCODE,'&NORMA',NVNOSI,MCNOSI)
      ENDIF
      IF (NOEGAM.EQ.'Y') THEN
 --      Tableau #ORNOE 
         (pour les coordonnees des noeuds en ligne) sur Gamma
         CALL TBRR1  (ERCODE,'#ORNOE',INTRGL,NBTNGL)
      ENDIF
      IF (NOESIG.EQ.'Y') THEN
 --      Tableaux #ORNOE,INTRSC
         (pour les coordonnees des noeuds en colonne) sur Sigma
         CALL TBRR1  (ERCODE,'#ORNOE',INTRSC,NBTNSC)
      ENDIF
 
 --   Creation des termes (Gdelta) * (Noyau)
      ITGDNO = ITNOYO
      IF (ITGDEL.EQ.ITCOMP) ITGDNO = ITGDEL
      TYGDNO = TYPINT (ITGDNO)
      LGGDNO = LIPDEL*LIGDEL
      ITYCAL = INTYKL ('COUPLA')                                        !utilite
      NUKALE = 1
      NUDONN = 0
      INDNSY = INDSYM (' ')                                             !utilite
      INDSTK = INDSTO ('PLEIN-L')                                       !utilite
 
 --   Calcul des termes (Gdelta) * (Noyau)
 
      IF (CALCUL(1:5).EQ.'local') THEN
 
         Calcul effectue element par element sur Sigma
         IF (NMGDNS.NE.' ') THEN
            CALL CRTERM (NMGDNS,NVGDNS,LGGDNO,ITGDNO,ITYCAL,NUKALE
     &                  ,NUDONN,INDNSY,NDFDSM,INCOPL,NDFDUM,LIPDEL
     &                  ,NVNLGA,INCOGL,NDFDUM,LIGDEL,NVNLGN,INDSTK
     &                  ,NDFSTO,NDFCOR,NDFNDF,NIVIMP,.FALSE.,CRETRM)    !sdexplo
         ENDIF
         IF (NMGDND.NE.' ') THEN
            CALL CRTERM (NMGDND,NVGDND,LGGDNO,ITGDNO,ITYCAL,NUKALE
     &                  ,NUDONN,INDNSY,NDFDSM,INCOPL,NDFDUM,LIPDEL
     &                  ,NVNLGA,INCOGL,NDFDUM,LIGDEL,NVNLGN,INDSTK
     &                  ,NDFSTO,NDFCOR,NDFNDF,NIVIMP,.FALSE.,CRETRM)    !sdexplo
         ENDIF
         IF (NOYAUX.EQ.'N') THEN
            CALL COSLGN (KPERSO,INTRGL,NVNLGA,NVNOGA,LIPDEL,INTRSC
     &                  ,NVNCSI,LIGDEL,NMGDEL(1:NCHTRM),NVGDEL,ITGDEL
     &                  ,IATRSI,ITNOYO,KLNOYO,TYPINT(ITFGRE),LAMBDC
     &                  ,NMTBAS,NVTBAS,TYTBAS
     &                  ,ITGDNO,NMGDNS,NVGDNS,NMGDND,NVGDND,NIVIMP)     !couplag
         ELSE
            GOTO 99902
         ENDIF
 
      ELSEIF (CALCUL(1:6).EQ.'global') THEN
 
         Calcul effectue globalement sur Sigma
         IF (NOYAUX.EQ.'N') THEN
             GOTO 99901
             CALL COSGGN (
     &                                                                 )!couplag
         ELSE
            IF (NMGDNS.NE.' ') THEN
               CALL CRTERM (NMGDNS,NVGDNS,LGGDNO,ITGDNO,ITYCAL,NUKALE
     &                     ,NUDONN,INDNSY,NDFDSM,INCOPL,NDFDUM,LIPDEL
     &                     ,NVNLGA,INCOGL,NDFDUM,LIGDEL,NVNLGN,INDSTK
     &                     ,NDFSTO,NDFCOR,NDFNDF,NIVIMP,.FALSE.,CRETRM) !sdexplo
               CALL TBAR1  (ERCODE,NMGDNS,NVGDNS,MCGDNS)
               CALL TAZERO (LGGDNO,TYGDNO,MCGDNS,AST,IST,RST,CST)       !utilite
               CALL COMOPL ('MOPL',NMGDEL(1:NCHTRM),NVGDEL,ITGDEL,ITYSYG
     &                     ,INDSTG,NVNUSG,1,LIGDEL,'NoyauS',NVNOYS
     &                     ,ITNOYO,1,KOGDEL,1,LIPDEL,NMGDNS,NVGDNS
     &                     ,ITGDNO,1,LIPDEL,NCHTRM,NIVIMP)              !couplag
            ENDIF
            IF (NMGDND.NE.' ') THEN
               CALL CRTERM (NMGDND,NVGDND,LGGDNO,ITGDNO,ITYCAL,NUKALE
     &                     ,NUDONN,INDNSY,NDFDSM,INCOPL,NDFDUM,LIPDEL
     &                     ,NVNLGA,INCOGL,NDFDUM,LIGDEL,NVNLGN,INDSTK
     &                     ,NDFSTO,NDFCOR,NDFNDF,NIVIMP,.FALSE.,CRETRM) !sdexplo
               CALL TBAR1  (ERCODE,NMGDND,NVGDND,MCGDND)
               CALL TAZERO (LGGDNO,TYGDNO,MCGDND,AST,IST,RST,CST)       !utilite
               CALL COMOPL ('MOPL',NMGDEL(1:NCHTRM),NVGDEL,ITGDEL,ITYSYG
     &                     ,INDSTG,NVNUSG,1,LIGDEL,'NoyauD',NVNOYD
     &                     ,ITNOYO,1,KOGDEL,1,LIPDEL,NMGDND,NVGDND
     &                     ,ITGDNO,1,LIPDEL,NCHTRM,NIVIMP)              !couplag
            ENDIF
         ENDIF
 
      ELSE
         CALL PRSDGN (NUSGGD,IMPPAL)                                    !prsd
         CALL ERTERM (24,NMGDEL(1:NCHTRM),NVGDEL)                       !utilite
      ENDIF
      IF (LGWOR2.GT.0) CALL TBTUER ('$WORK$',2)
      CALL TBSAVE ('#GNEDO',NVNCSI)
      CALL TBSAVE ('#GNEDO',NVNLGA)
      IF (NOEGAM.EQ.'Y') CALL TBSAVE ('#ORNOE',INTRGL)
      IF (NORGAM.EQ.'Y') CALL TBSAVE ('&NORMA',NVNOGA)
      IF (NOESIG.EQ.'Y') CALL TBSAVE ('#ORNOE',INTRSC)
      IF (NORSIG.EQ.'Y') CALL TBSAVE ('&NORMA',NVNOSI)
      IF (NUGDEL.GT.0)   CALL TBSAVE (NMGDEL(1:NCHTRM),NVGDEL)
 
      IF (NMGDNS.NE.' ') THEN
          IF (NIVIMP.GE.0.AND.IMPPAL.GT.0) THEN
             CALL PRNTRM (NMGDNS,NVGDNS,ERCODE,NCATR1)
             WRITE (IMPPAL,10000) CALCUL,'simple',ERCODE(1:NCATR1)
             IF (NIVIMP.GT.1) CALL PRTERM (NMGDNS,NVGDNS,NIVIMP,IMPSDR) !prsd
          ENDIF
          CALL TBSAVE (NMGDNS,NVGDNS)
      ENDIF
      IF (NMGDND.NE.' ') THEN
          IF (NIVIMP.GE.0.AND.IMPPAL.GT.0) THEN
             CALL PRNTRM (NMGDND,NVGDND,ERCODE,NCATR1)
             WRITE (IMPPAL,10000) CALCUL,'double',ERCODE(1:NCATR1)
             IF (NIVIMP.GT.1) CALL PRTERM (NMGDND,NVGDND,NIVIMP,IMPSDR) !prsd
          ENDIF
          CALL TBSAVE (NMGDND,NVGDND)
      ENDIF
      CALL TBSAVE ('$GDNOY',NUSGGD)
      CALL PRFXMJ (-1,'*CoGdNo*') 
      RETURN 
line
10000 FORMAT(/T2,'*CoGdNo* Calcul ',A,' de Gdelta*Noyau de ',A
     &,' couche ',A)
line
99990 CALL PRNTRM (NMGDNS,NVGDNS,ERCODE,NCATR1)
      CALL PRNTRM (NMGDND,NVGDND,ERCODE(NCATR1+1:),NCATR2)
      CALL BAISE  ('Structure $GDNOYS differentes pour les termes '
     &//ERCODE(1:NCATR1) //' et '//ERCODE(NCAR1+1:NCATR1+NCATR2)//'.')
99991 CALL BAISE  ('Incoherence entre le nombre de noeuds sur Sigma'
     &//' et le nombre de colonnes de la matrice Gdelta.')
99992 CALL BAISE  ('Bug de MELINA dans le calcul des normales sur Gamma'
     &//'. Il est actuellement necessaire que les interpolations'
     &//' en ligne et colonne sur Gamma coincident.')
99993 CALL BAISE  ('Bug de MELINA dans le calcul des normales sur Gamma'
     &//'. Il est actuellement necessaire que le nombre de noeuds'
     &//' en ligne et colonne coincident.')
99994 CALL PRNTRM (NMGDNS,NVGDNS,ERCODE,NCATR1)
      CALL PRNTRM (NMGDND,NVGDND,ERCODE(NCATR1+1:),NCATR2)
      CALL BAISE  ('Pas de structure $GDNOYS pour les termes '
     &//ERCODE(1:NCATR1) //' et '//ERCODE(NCAR1+1:NCATR1+NCATR2)//'?')
99901 CALL PRNTRM (NMGDEL(1:NCHTRM),NVGDEL,ERCODE,NCATR1)
      CALL BAISE  ('Vous utilisez *CoGdNo* dans le cas d''un calcul '
     &//' global sur Sigma (la matrice Gdelta='
     &//ERCODE(1:NCATR1)//' est assemblee :'
     &//' ''TERME ELEMENTS FINIS''), '
     &//'les noyaux doivent etre calcules prealablement par *Calnoy* '
     &//'comme tableaux de noms NoyauS et/ou NoyauD.'
     &//' Pour effectuer un calcul local, la matrice Gdelta ne doit'
     &//' pas etre assemblee (''TERME MATRICE ELEMENTAIRE'').') 
99902 CALL PRNTRM (NMGDEL(1:NCHTRM),NVGDEL,ERCODE,NCATR1)
      CALL BAISE  ('Vous utilisez *CoGdNo* dans le cas d''un calcul '
     &//' local sur Sigma (la matrice Gdelta='
     &//ERCODE(1:NCATR1)//' n''est pas assemblee :'
     &//' (''TERME MATRICE ELEMENTAIRE''), '
     &//'les noyaux sont calcules dans l''algorithme.'
     &//' Pour effectuer un calcul glocal, la matrice Gdelta doit'
     &//' etre assemblee (''TERME ELEMENTS FINIS'').')
                                                                    END !CoGdNo
line
top

cogdno est appelé dans (6 procédures)

00README-couplag.txt cognop.f (couplag) gettrm-calls.txt
logfile pph3new.f (A_helmz3d) pphelmz3_s.f (E_4helmz3d)

top