[updated 3.May.2002]
Librairie caltrm > Fichier vncalc.f |
SUBROUTINE VNCALC (NMTERM,NVTERM,NUVANO,NCPINC,NVALNE,MCTERM
& ,TYPTRM,NOMFCT,TYPFCT
& ,NODONA,NVDONA,TYDONA,TYPRAS,MCASSO
& ,NDIM,NBRNOE,NUGNOE,CORNOE,NORNOE,IST,RST,CST)
Auteur : D.Martin (Novembre 1989)
Derniere modification : D.Martin (11 Novembre 1999)
Version 1.0.0
Calcul de termes 'Valeurs Nodales'
-- Arguments --
NUVANO code entier designant le type du terme Valeurs Nodales
NCPINC nombre de composantes par noeud pour l'inconnue associee au terme
NVALNE nombre de valeurs du terme par noeud
MCTERM adresse du terme valeurs nodales
TYPTRM type du terme ('REEL' ou 'COMPLEXE')
NOMFCT nom associe a la fonction associee au terme
TYPFCT type du resultat fourni par la fonction ('REEL' ou 'COMPLEXE')
NODONA nom de la donnee associee
NVDONA niveau de la donnee associee
TYDONA type de la donnee associee ('CONSTANTE' ou 'TABLEAU')
TYPRAS type de la constante ou du tableau ('REEL' ou 'COMPLEXE')
MCASSO adresse de la donnee associee (tableau ou constante) dans le super-
tableau defini par TYPRAS
NDIM dimension d'espace
NBRNOE nombre de noeuds du domaine pour l'interpolation adequate
NUGNOE numeros globaux des noeuds du domaine pour l'interpolation adequate
CORNOE tableau des coordonnees des noeuds pour l'interpolation adequate
NORNOE tableau des composantes des normales
IST,RST,CST super-tableau version entiere, reelle ou complexe
CHARACTER*(*) NMTERM,TYPTRM,NOMFCT,TYPFCT,NODONA,TYDONA,TYPRAS
INTEGER NVTERM,NUVANO,NCPINC,NVALNE,MCTERM,NVDONA,MCASSO
& ,NDIM,NBRNOE,NUGNOE(*),IST(*)
REAL NORNOE(NDIM,*),CORNOE(NDIM,*),RST(*)
COMPLEX CST(*)
CHARACTER*7 VANOCH,VANOIN
INTEGER INVANO,NOEGLO,INE,ADRS,ADRS1,I,J
REAL DOTPR,TABREL(9)
COMPLEX DOTPC,TABCOM(9)
CALL PRFXMJ (1,'*VnCalc*')
ADRS=MCTERM
VANOCH=VANOIN (NUVANO)
IF (NUVANO.EQ.INVANO ('F')) THEN
Valeurs nodales 'simple' : f[i] ou F[i]
IF (TYPTRM(:1).EQ.'R') THEN
DO 109 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
On utilise les tableaux intermediaires au cas ou l'utilisateur
fournirait plus de valeurs qu'attendues !
DO 101 I=1,NVALNE
RST(ADRS)=TABREL(I)
ADRS=ADRS+1
101 CONTINUE
109 CONTINUE
ELSE
DO 119 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
DO 111 I=1,NVALNE
CST(ADRS)=TABCOM(I)
ADRS=ADRS+1
111 CONTINUE
119 CONTINUE
ENDIF
ELSEIF (VANOCH(1:5).EQ.'DF/DN') THEN
'derivee normale' : df/dn([i] = n.grad(f)[i]
IF (NVALNE.GT.1) CALL ERTERM (27,NMTERM,NVTERM)
IF (TYPTRM(:1).EQ.'R') THEN
DO 209 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL DFCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
DOTPR=0.
DO 201 I=1,NDIM
DOTPR=DOTPR+NORNOE(I,INE)*TABREL(I)
201 CONTINUE
RST(ADRS)=DOTPR
ADRS=ADRS+1
209 CONTINUE
ELSE
DO 219 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL DFCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
DOTPC=0.
DO 211 I=1,NDIM
DOTPC=DOTPC+NORNOE(I,INE)*TABCOM(I)
211 CONTINUE
CST(ADRS)=DOTPC
ADRS=ADRS+1
219 CONTINUE
ENDIF
ELSEIF (NUVANO.EQ.INVANO ('NF')) THEN
'produit par la normale' : nf[i]
IF (TYPTRM(:1).EQ.'R') THEN
DO 409 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
ADRS1=ADRS
DO 401 I=1,NDIM
RST(ADRS1)=NORNOE(I,INE)*TABREL(1)
ADRS1=ADRS1+1
401 CONTINUE
ADRS=ADRS+NVALNE
409 CONTINUE
ELSE
DO 419 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
ADRS1=ADRS
DO 411 I=1,NDIM
CST(ADRS1)=NORNOE(I,INE)*TABCOM(1)
ADRS1=ADRS1+1
411 CONTINUE
ADRS=ADRS+NVALNE
419 CONTINUE
ENDIF
ELSEIF (NUVANO.EQ.INVANO ('N.F')) THEN
'composante normale' : n.F[i]
( derivee normale si F[i] est un gradient )
IF (NVALNE.GT.1) CALL ERTERM (27,NMTERM,NVTERM)
IF (TYPTRM(:1).EQ.'R') THEN
DO 509 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
DOTPR=0.
DO 501 I=1,NDIM
DOTPR=DOTPR+NORNOE(I,INE)*TABREL(I)
501 CONTINUE
RST(ADRS)=DOTPR
ADRS=ADRS+1
509 CONTINUE
ELSE
DO 519 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
DOTPC=0.
DO 511 I=1,NDIM
DOTPC=DOTPC+NORNOE(I,INE)*TABCOM(I)
511 CONTINUE
CST(ADRS)=DOTPC
ADRS=ADRS+1
519 CONTINUE
ENDIF
ELSEIF (NUVANO.EQ.INVANO ('N^F')) THEN
'composante' tangentielle : n^F[i]
IF (TYPTRM(:1).EQ.'R') THEN
DO 609 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
CALL TVECTT (NDIM,'R',1,NORNOE(1,INE),CST
& ,NCPINC,'R',1,TABREL,CST,'R',ADRS,RST,CST) !utilite
ADRS=ADRS+NVALNE
609 CONTINUE
ELSE
DO 619 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
CALL TVECTT (NDIM,'R',1,NORNOE(1,INE),CST
& ,NCPINC,'C',1,RST,TABCOM,'C',ADRS,RST,CST) !utilite
ADRS=ADRS+NVALNE
619 CONTINUE
ENDIF
ELSEIF (NUVANO.EQ.INVANO ('F^N')) THEN
'composante' tangentielle : F[i]^n
IF (TYPTRM(:1).EQ.'R') THEN
DO 709 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
CALL TVECTT (NCPINC,'R',1,TABREL,CST,NDIM
& ,'R',1,NORNOE(1,INE),CST,'R',ADRS,RST,CST) !utilite
ADRS=ADRS+NVALNE
709 CONTINUE
ELSE
DO 719 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
CALL TVECTT (NCPINC,'C',1,RST,TABCOM,NDIM
& ,'R',1,NORNOE(1,INE),CST,'C',ADRS,RST,CST) !utilite
ADRS=ADRS+NVALNE
719 CONTINUE
ENDIF
ELSEIF (VANOCH(1:7).EQ.'N^(N^F)') THEN
projection tangentielle : n^(n^F[i]) = F[i]-(n.F[i])n
IF (TYPTRM(:1).EQ.'R') THEN
DO 809 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
ADRS1=ADRS
DOTPR=0.
DO 801 I=1,NDIM
DOTPR=DOTPR+NORNOE(I,INE)*TABREL(I)
801 CONTINUE
DO 802 I=1,NDIM
RST(ADRS1)=TABREL(I)-DOTPR*NORNOE(I,INE)
ADRS1=ADRS1+1
802 CONTINUE
ADRS=ADRS+NVALNE
809 CONTINUE
ELSE
DO 819 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
ADRS1=ADRS
DOTPC=0.
DO 811 I=1,NDIM
DOTPC=DOTPC+NORNOE(I,INE)*TABCOM(I)
811 CONTINUE
DO 812 I=1,NDIM
CST(ADRS1)=TABCOM(I)-DOTPC*NORNOE(I,INE)
ADRS1=ADRS1+1
812 CONTINUE
ADRS=ADRS+NVALNE
819 CONTINUE
ENDIF
ELSEIF (VANOCH(1:6).EQ.'N(N.F)') THEN
projection normale : n(n.F[i])
IF (TYPTRM(:1).EQ.'R') THEN
DO 909 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
ADRS1=ADRS
DOTPR=0.
DO 901 I=1,MIN (NDIM,NCPINC)
DOTPR=DOTPR+NORNOE(I,INE)*TABREL(I)
901 CONTINUE
DO 902 I=1,NDIM
RST(ADRS1)=DOTPR*NORNOE(I,INE)
ADRS1=ADRS1+1
902 CONTINUE
ADRS=ADRS+NVALNE
909 CONTINUE
ELSE
DO 919 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
ADRS1=ADRS
DOTPC=0.
DO 911 I=1,MIN (NDIM,NCPINC)
DOTPC=DOTPC+NORNOE(I,INE)*TABCOM(I)
911 CONTINUE
DO 912 I=1,NDIM
CST(ADRS1)=DOTPC*NORNOE(I,INE)
ADRS1=ADRS1+1
912 CONTINUE
ADRS=ADRS+NVALNE
919 CONTINUE
ENDIF
ELSEIF (VANOCH(1:3).EQ.'N1F'.OR.VANOCH(1:3).EQ.'N2F'
& .OR.VANOCH(1:3).EQ.'N3F') THEN
'produit par une composante de la normale' : n_j.f[i]
CALL RELCNE (VANOCH(2:2),J)
IF (TYPTRM(:1).EQ.'R') THEN
DO 1009 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
ADRS1=ADRS
DO 1001 I=1,NVALNE
RST(ADRS1)=NORNOE(J,INE)*TABREL(I)
ADRS1=ADRS1+1
1001 CONTINUE
ADRS=ADRS+NVALNE
1009 CONTINUE
ELSE
DO 1019 INE=1,NBRNOE
NOEGLO=NUGNOE(INE)
CALL FCTRM (NDIM,CORNOE(1,NOEGLO),NOMFCT,TYPFCT,NODONA
& ,TYDONA,TYPRAS,MCASSO,IST,RST,CST
& ,TABREL,TABCOM)
ADRS1=ADRS
DO 1011 I=1,NVALNE
CST(ADRS1)=NORNOE(J,INE)*TABCOM(I)
ADRS1=ADRS1+1
1011 CONTINUE
ADRS=ADRS+NVALNE
1019 CONTINUE
ENDIF
ENDIF
CALL PRFXMJ (-1,'*VnCalc*')
RETURN
END !VnCalc
vncalc est appelé dans