[updated 23.Sep.1994]

Librairie couplag > Fichier rldgtr.f

Qui appelle rldgtr ?

line
      SUBROUTINE RLDGTR (NBNECO,NGNECO,NBNELI,NGNELI,ITYSYG
     &                  ,NULAPL,IPLAGL,NULAPU,IPLAGU,ITYPTR,MCTERM
     &                  ,NBNEFR,NGNEFR,NBNERE,NGNERE,MCTRMR,RST,CST)
line
  Auteur : O.DeBayser (Decembre 1989)
  Derniere modification : D.Martin le 23 Septembre 1994  
 
  Constitution d'un terme de relevement compacte "BIMORSE" partie diagonale
   
 -- Arguments d'entree -- 
  NBNECO nombre de colonnes du terme dont on extrait le relevement
  NGNECO numeros globaux des noeuds pour l'interpolation en colonne
  NBNELI nombre de lignes du terme dont on extrait le relevement
  NGNELI numeros globaux des noeuds pour l'interpolation en ligne 
  ITYSYG indice de symetrie du terme dont on extrait le relevement 
  NULAPL tableau des numero de derniere plage triangle inferieur
  IPLAGL tableau des debut et longueur de plages triangle inferieur
  NULAPU tableau des numero de derniere plage triangle superieur
  IPLAGU tableau des debut et longueur de plages triangle superieur
  ITYPTR Indice de type (REEL ou COMPLEXE) du terme
  MCTERM adresse du terme en m.c. du terme dont on extrait le relevement
  NBNEFR nombre de noeuds de la frontiere de relevement
  NGNEFR numeros globaux des noeuds de la frontiere
  NBNERE nombre de noeuds du domaine de relevement
  NGNERE numeros globaux des noeuds du domaine de relevement
  MCTRMR adresse du terme releve en m.c.
  RST,CST super-tableaux version reelle et complexe
line
      INTEGER       NBNECO,NGNECO(*),NBNELI,NGNELI(*),ITYSYG  
     &             ,NULAPL(*),IPLAGL(2,*),NULAPU(*),IPLAGU(2,*),ITYPTR
     &             ,MCTERM,NBNEFR,NGNEFR(*),NBNERE,NGNERE(*),MCTRMR
      REAL          RST(*) 
      COMPLEX       CST(*) 
 
      INTEGER       INDSYM,INTTYP
line
      INTREL=INTTYP ('REEL')                                            !Utilite
      NXDIAL=1 
      NXDIAC=1 
      LGCUAR=MCTRMR
      LGMORL=0
      IF (ITYSYG.EQ.INDSYM (' ')) THEN                                  !Utilite
         NUDRPL=NULAPL(NBNELI-1)
         LGMORL=IPLAGL(2,NUDRPL)
      ENDIF
 
      DO 10 INERE=1,MIN(NBNEFR,NBNERE)
         calcul de l'adresse du bon coef. dans le terme de volume
         NUGLOL=NGNERE(INERE)
         CALL DICOTO (NXDIAL,NBNELI,NGNELI,NUGLOL,NEDIAL,*99991)        !Utilite
         NXDIAL=NEDIAL+1
         NUGLOC=NGNEFR(INERE)
         CALL DICOTO (NXDIAC,NBNECO,NGNECO,NUGLOC,NEDIAC,*99992)        !Utilite
         NXDIAC=NEDIAC+1
         IF (NEDIAL.EQ.NEDIAC) THEN
            il est sur la diagonale
            IADRES=NEDIAL
         ELSEIF (NEDIAL.GT.NEDIAC) THEN
            il est dans le triangle inferieur
            NUDRPL=0
            LGCUAL=0
            IF (NEDIAL.GT.2) NUDRPL=NULAPL(NEDIAL-2)
            IF (NUDRPL.GT.0) LGCUAL=IPLAGL(2,NUDRPL)
            NUPRPL=NUDRPL+1
            NUDRPL=NULAPL(NEDIAL-1)
            CALL DIKLPL (NEDIAC,NUPRPL,NUDRPL,LGCUAL,IPLAGL,NUPLIG,*2)  !Morse
            LGCUAL=0
            IF (NUPLIG.GT.1) LGCUAL=IPLAGL(2,NUPLIG-1)
            KOLDEB=IPLAGL(1,NUPLIG)
            IADRES=MIN(NBNECO,NBNELI)+LGCUAL+NEDIAC-KOLDEB+1
         ELSEIF (NEDIAL.LT.NEDIAC) THEN
            il est dans le triangle superieur
            NUDRPL=0
            LGCUAL=0
            IF (NEDIAC.GT.2) NUDRPL=NULAPU(NEDIAC-2)
            IF (NUDRPL.GT.0) LGCUAL=IPLAGU(2,NUDRPL)
            NUPRPL=NUDRPL+1
            NUDRPL=NULAPU(NEDIAC-1)
            CALL DIKLPL (NEDIAL,NUPRPL,NUDRPL,LGCUAL,IPLAGU,NUPLIG,*2)  !Morse
            LGCUAL=0
            IF (NUPLIG.GT.1) LGCUAL=IPLAGU(2,NUPLIG-1)
            KOLDEB=IPLAGU(1,NUPLIG)
            IADRES=MIN (NBNECO,NBNELI)+LGMORL+LGCUAL+NEDIAL-KOLDEB+1
         ENDIF
         IADRES=MCTERM-1+IADRES
         IF (ITYPTR.EQ.INTREL) THEN
            RST(LGCUAR)=RST(IADRES)
         ELSE
            CST(LGCUAR)=CST(IADRES)
         ENDIF
         LGCUAR=LGCUAR+1
         GOTO 10
 
2        IF (ITYPTR.EQ.INTREL) THEN
            RST(LGCUAR)=0.
         ELSE
            CST(LGCUAR)=0.
         ENDIF
3        LGCUAR=LGCUAR+1
10    CONTINUE
      RETURN
line
99991 WRITE (*,*) NXDIAL,NBNELI,NGNELI(NXDIAL),NGNELI(NBNELI),NUGLOL
     &           ,NEDIAL
      CALL BAISE  (' *Rldgtr* Le numero global NUGLOL doit se trouver da
     &ns la numerotation en ligne ')                                    !Utilite
99992 WRITE (*,*) NXDIAC,NBNECO,NGNECO(NXDIAC),NGNECO(NBNECO),NUGLOC
     &           ,NEDIAC
      CALL BAISE  (' *Rldgtr* Le numero global NUGLOC doit se trouver da
     &ns la numerotation en colonne ')                                  !Utilite
                                                                    END !Rldgtr
line
top

rldgtr est appelé dans (2 procédures)

top