C COMBT1 SOURCE CB215821 20/11/25 13:21:47 10792 SUBROUTINE COMBT1 (IPCHP1,IPTABL,COMBIN,IPCHP2) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) ************************************************************************ * * C O M B T 1 * ----------- * * FONCTION: * --------- * * EFFECTUER LA COMBINAISON LINEAIRE DE CHPOINTS CONSIGNES DANS UNE * TABLE, INDICES PAR DES POINTS. * * MODE D'APPEL: * ------------- * * CALL COMBT1 (IPCHP1,IPTABL,COMBIN,IPCHP2) * * PARAMETRES: (E)=ENTREE (S)=SORTIE * ----------- * * IPCHP1 ENTIER (E) POINTEUR SUR LE CHPOINT DES COEFFICIENTS DE * PONDERATION (VOIR LE SOUS-PROGRAMME * "COMBTA" OU L'OPERATEUR "COMBTABLE" POUR LE * DETAIL DE SON CONTENU). * IPTABL ENTIER (E) POINTEUR SUR LA TABLE DES CHPOINTS. * COMBIN SUBROUT. (E) SOUS-PROGRAMME DE COMBINAISON LINEAIRE DE * 2 CHPOINTS. 5 ARGUMENTS: * - CHPOINT N.1 , * - REEL D.P. N.1 , * - CHPOINT N.2 , * - REEL D.P. N.2 , * - CHPOINT COMBINAISON LINEAIRE. * IPCHP2 ENTIER (S) POINTEUR SUR LE CHPOINT COMBINE. * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL MANIGOT 30 MAI 1985 * * LANGAGE: * -------- * * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS. * ************************************************************************ * -INC PPARAM -INC CCOPTIO -INC SMCHPOI -INC SMELEME -INC SMTABLE -INC SMVECTD * LOGICAL FIRST,LBID CHARACTER*1 CBID EXTERNAL COMBIN * * FIRST = .TRUE. MCHPOI = IPCHP1 SEGACT,MCHPOI * NSOUPO = IPCHP(/1) DO 100 IB100=1,NSOUPO * MSOUPO = IPCHP(IB100) SEGACT,MSOUPO NC = NOCOMP(/2) IF (NC .NE. 1) THEN * LE CHPOINT DES COEFFICIENTS DE PONDERATION A PLUSIEURS * COMPOSANTES: ON NE SAIT PAS QUOI EN FAIRE. NUMERR = 180 CALL ERREUR (NUMERR) RETURN END IF * MELEME = IGEOC SEGACT,MELEME NBNN = NUM(/1) IF (NBNN .NE. 1) THEN * ON NE COMPREND PAS QUE L'OBJET "MAILLAGE" NE CONTIENNE PAS * DES ELEMENTS A 1 SEUL NOEUD. MOTERR(1:8) = '"COMBT1"' NUMERR = 224 CALL ERREUR (NUMERR) RETURN END IF * MPOVAL = IPOVAL SEGACT,MPOVAL NBPOIN = VPOCHA(/1) NBELEM = NUM(/2) IF (NBPOIN .NE. NBELEM) THEN * TYPE DE RELATION ENTRE LE 'CHPOINT' ET SON SUPPORT INCOMPRIS MOTERR(1:8) = '"COMBT1"' NUMERR = 224 CALL ERREUR (NUMERR) RETURN END IF * mtable=iptabl segact mtable,mtab1 DO 110 IB110=1,NBPOIN INDICE = NUM(1,IB110) do iou=1,mlotab if(mtabii(iou).eq.indice) go to 32 enddo call erreur(5) 32 continue ipchp3=mtabiv(iou) mvect1= mtab1.mtabiv(iou) INDICE = NUM(1,IB110) write(6,*) ib110 ,'ieme point numero ' , indice * CALL ACCTAB (IPTABL,'POINT',IBID,XBID,CBID,LBID,INDICE * & ,'CHPOINT',IBID,XBID,CBID,LBID,IPCHP3) * IF (IERR .NE. 0) RETURN * segact mvect1 COEFF3 = VPOCHA(IB110,1) IF (FIRST) THEN inc=mvect1.vectbb(/1) segini,mvect3 do iau=1,mvect1.vectbb(/1) mvect3.vectbb(iau)=mvect1.vectbb(iau)*coeff3 enddo FIRST = .FALSE. * MULTPL = 1 * CALL MUCHPO (IPCHP3,COEFF3, IPCHP2,MULTPL) * IF (IERR .NE. 0) RETURN ELSE do iau=1,inc mvect3.vectbb(iau)=mvect3.vectbb(iau)+ $ coeff3*mvect1.vectbb(iau) enddo * COEFF2 = 1.D0 * CALL COMBIN (IPCHP2,COEFF2,IPCHP3,COEFF3, IPCHP9) * IF (IERR .NE. 0) RETURN * CALL DTCHPO (IPCHP2) * IPCHP2 = IPCHP9 END IF * 110 CONTINUE *** call crech2(ipchp2,mvect3,mvecri,1) *** segsup mvect3 segdes mtable,mtab1 * END DO * SEGDES,MELEME SEGDES,MPOVAL SEGDES,MSOUPO * 100 CONTINUE * END DO * SEGDES,MCHPOI * END