Numérotation des lignes :

C RLENCT    SOURCE    CHAT      05/01/13    03:01:32     5004      SUBROUTINE RLENCT(MELFL,MELSOM,MLEPOI,MLECOE,MLEPOF,MLECOF)C************************************************************************CC PROJET            :  CASTEM 2000CC NOM               :  RLENCTCC DESCRIPTION       :  Appelle par GRADI2CC LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)CC AUTEUR            :  A. BECCANTINICC************************************************************************CCC     This subroutine computes the coefficients to compute the gradientC     at intefaces with respect to the values on its neighbors.C     The neighbors are 'CENTRE' points or 'boundary condition' points.CC**** Inputs:CC     MELFL  = 'FACEL' melemeCC     MELSOM = 'SOMMET' melemeCC     MLEPOI = list of integers.C              MLEPOI.LECT(i) points to the list neighbors ofC              MELSOM.NUM(1,I). Neighbors are 'CENTRE' points orC              'boundary condition' pointsC     MLECOE =  list of integers.C               MLECOE.LECT(i) points to the list of real of coeffientsC               to compute the vertex valuesCC     MLEPOF = list of integers.C              MLEPOI.LECT(i) points to the list neighbors ofC              MELFL.NUM(2,i). Neighbors are 'CENTRE' points orC              'SOMMET' points.C     MLECOF =  list of integers.C               MLECOE.LECT(i) points to the matrix of coeffients toC               compute the gradient with respect the neighbors valueCC**** Output:CC     MLEPOF = list of integers.C              MLEPOI.LECT(i) points to the list neighbors ofC              MELFL.NUM(2,i). Neighbors are 'CENTRE' points orC              'boundary condition' points. The first one is theC              'FACE' point itself.C     MLECOE =  list of integers.C               MLECOE.LECT(i) points to the matrix of coeffients toC               compute the gradientCC**** Variables de COOPTIOCC      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERRC     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQC     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORESC     &        ,IECHO,   IIMPI,  IOSPIC     &        ,IDIMCC     &        ,MCOORDC     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVEC     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLUC     &        ,NORINC,NORVAL,NORIND,NORVADC     &        ,NUCROU, IPSAUV, IFICLE, IPREFICC      IMPLICIT INTEGER(I-N)-INC CCOPTIO-INC SMCOORD-INC SMLENTI-INC SMLREEL-INC SMELEMEC      INTEGER NTP, NFAC, IFAC, NVOIF, IVOIF, NGV, NLS, NLV     &     ,NVOIS,IVOIS,NGVS, LAST, LAST0, NSOMM, IPOS     &     ,I1,ICELL,NGF      REAL*8 CELL      INTEGER JG      INTEGER N1,N2      SEGMENT MATRIX      REAL*8 MAT(N1,N2)      ENDSEGMENT      POINTEUR MELSOM.MELEME, MLEPOI.MLENTI,MLECOE.MLENTI, MELFL.MELEME     &     ,MLEPOF.MLENTI,MLECOF.MLENTI     &     ,MATCOE.MATRIX,MATCO1.MATRIX,MLRCOE.MLREEL,MLREST.MLENTI     &     ,MLESOM.MLENTI,MLPOSI.MLENTICC      SEGACT MELFLC      NTP=MCOORD.XCOOR(/1)/(IDIM+1)CC**** Chaining listC     LASTC     MLREST(NTP)C      JG=NTP      SEGINI MLREST      LAST=-1CC**** Position of a point in the list of neighborsC     MLREST is used to clean it at the endC      JG=NTP      SEGINI MLPOSICC**** We create the MLENTI for the sommetsC      CALL KRIPAD(MELSOM,MLESOM)      IF(IERR .NE. 0)GOTO 9999C     En KRIPADC     SEGACT MELSOMC     SEGINI MLESOMC      SEGACT MLEPOF*MOD      NFAC=MLEPOF.LECT(/1)      SEGACT MLECOF*MODC      SEGACT MLEPOI      SEGACT MLECOEC      NSOMM=MLEPOI.LECT(/1)      DO I1=1,NSOMM,1         MLENTI=MLEPOI.LECT(I1)         SEGACT MLENTI         MLREEL=MLECOE.LECT(I1)         SEGACT MLREEL      ENDDOC      DO IFAC=1,NFAC,1         NGF=MELFL.NUM(2,IFAC)         MLENT1=MLEPOF.LECT(IFAC)         SEGACT MLENT1         NVOIF=MLENT1.LECT(/1)CC******* We fill MLREST, MLPOSIC         LAST=-1         IPOS=1         MLREST.LECT(NGF)=LAST         LAST=NGF         DO IVOIF=1,NVOIF,1            NGV=MLENT1.LECT(IVOIF)CC********** First of all, we have to check if this is aC           'SOMMET' point. In that case we have to replaceC           it by its neighbors.C            NLS=MLESOM.LECT(NGV)C            IF(NLS .GT. 0)THENC             'SOMMET'               MLENT2=MLEPOI.LECT(NLS)               NVOIS=MLENT2.LECT(/1)               DO IVOIS=1,NVOIS,1                  NGVS=MLENT2.LECT(IVOIS)                  NLV=MLREST.LECT(NGVS)                  IF(NLV .EQ. 0)THENCC**************** New pointC                     IPOS=IPOS+1                     MLREST.LECT(NGVS)=LAST                     LAST=NGVS                  ENDIF               ENDDO            ELSEC             'CENTRE'               NLV=MLREST.LECT(NGV)               IF(NLV .EQ. 0)THENCC************* New pointC                  IPOS=IPOS+1                  MLREST.LECT(NGV)=LAST                  LAST=NGV               ENDIF            ENDIF         ENDDOCC********** We create the new list of neighborsC         JG=IPOS         SEGINI MLENTI         MLEPOF.LECT(IFAC)=MLENTI         LAST0=LAST         DO IVOIF=1,IPOS,1            I1=(IPOS-IVOIF)+1            MLENTI.LECT(I1)=LAST            MLPOSI.LECT(LAST)=I1            LAST=MLREST.LECT(LAST)         ENDDO         IF(LAST .NE. -1)THEN            WRITE(IOIMP,*) 'subroutine rlenct.eso'            CALL ERREUR(5)         ENDIF         LAST=LAST0CC******* SummarizingCC        MLENTI: list of the new 'FACE' neighborsC        MLENT1: list of the old 'FACE' neighborsC        MLENT2: is free. It has been used and it will be usedC                for the 'SOMMET' neighbors.C        MLPOSI: position of the new neighbors into MLENTIC        MLREST + LAST : chaining list, used to clean MLPOSICC******* Let us callC        MATCOE: matrix of the 'FACE' coeff (IDIM+1,*)C        MATCO1: matrix of the old 'FACE' coeff. (IDIM+1,*)C        MLRCOE: list of the 'SOMMET coeffCC         MATCO1=MLECOF.LECT(IFAC)         SEGACT MATCO1         N1=IDIM+1         N2=MLENTI.LECT(/1)         SEGINI MATCOE         MLECOF.LECT(IFAC)=MATCOECC******* Loop on the old 'FACE' neighborsC         NVOIF=MLENT1.LECT(/1)         DO IVOIF=1,NVOIF,1            NGV=MLENT1.LECT(IVOIF)            NLS=MLESOM.LECT(NGV)C            IF(NLS .GT. 0)THENC             'SOMMET'               MLENT2=MLEPOI.LECT(NLS)               MLRCOE=MLECOE.LECT(NLS)               NVOIS=MLENT2.LECT(/1)               DO IVOIS=1,NVOIS,1                  NGVS=MLENT2.LECT(IVOIS)                  IPOS=MLPOSI.LECT(NGVS)                  IF(IPOS .EQ. 0)THEN                     WRITE(IOIMP,*) 'subroutine rlenct.eso'                     CALL ERREUR(5)                  ENDIF                  DO I1=1,IDIM+1,1                     MATCOE.MAT(I1,IPOS)=MATCOE.MAT(I1,IPOS)+     &                    (MATCO1.MAT(I1,IVOIF)*MLRCOE.PROG(IVOIS))                  ENDDO               ENDDO            ELSEC             'CENTRE'               IPOS=MLPOSI.LECT(NGV)               DO I1=1,IDIM+1,1                  MATCOE.MAT(I1,IPOS)=MATCOE.MAT(I1,IPOS)+     &                 MATCO1.MAT(I1,IVOIF)               ENDDO            ENDIF         ENDDOCCCCC******* TestCCC         ipos=mlenti.lect(/1)C         write(*,*) 'ngf=',melfl.num(2,ifac)C         write(*,*) 'ntvois=',iposC         write(*,*) 'nvois=',(mlenti.lect(ivoif),ivoif=1,ipos,1)C         write(*,*) 'Position=',C     &        (mlposi.lect(mlenti.lect(ivoif)),ivoif=1,ipos,1)C         write(*,*) 'coeff(1) =',(matcoe.mat(1,ivoif),ivoif=1,ipos,1)C         write(*,*) 'coeff(2) =',(matcoe.mat(2,ivoif),ivoif=1,ipos,1)C         write(*,*) 'coeff(3) =',(matcoe.mat(3,ivoif),ivoif=1,ipos,1)C         if(idim.eq.3) write(*,*) 'coeff(4)=',C     &        (matcoe.mat(4,ivoif),ivoif=1,ipos,1)C         cell=0.0D0C         do ivoif=1,ipos,1C            cell=cell+matcoe.mat(1,ivoif)C         enddoC         write(*,*) 'sum=',cellC         if(abs(cell-1.0d0) .gt. 1.0d-10)thenCC           It must be true if I just consider Dirichlet B.C.C            call erreur(5)C            goto 9999C         endifCC******* We clean MLPOSI and MLRESTC         NVOIS=MLENTI.LECT(/1)         DO IVOIF=1,NVOIS,1            MLPOSI.LECT(LAST)=0            ICELL=LAST            LAST=MLREST.LECT(ICELL)            MLREST.LECT(ICELL)=0         ENDDO         IF(LAST .NE. -1)THEN            WRITE(IOIMP,*) 'subroutine rlenct.eso'            CALL ERREUR(5)         ENDIFC         SEGSUP MATCO1         SEGSUP MLENT1         SEGDES MATCOE         SEGDES MLENTIC      ENDDOCCCC******* TestCCC      do ifac=1,nfac,1C         mlenti=mlepof.lect(ifac)C         matcoe=mlecof.lect(ifac)C         segact mlentiC         segact matcoeC         ipos=mlenti.lect(/1)C         write(*,*) 'ngf=',melfl.num(2,ifac)C         write(*,*) 'ntvois=',iposC         write(*,*) 'nvois=',(mlenti.lect(ivoif),ivoif=1,ipos,1)C         write(*,*) 'coeff(1) =',(matcoe.mat(1,ivoif),ivoif=1,ipos,1)C         write(*,*) 'coeff(2) =',(matcoe.mat(2,ivoif),ivoif=1,ipos,1)C         write(*,*) 'coeff(3) =',(matcoe.mat(3,ivoif),ivoif=1,ipos,1)C         if(idim.eq.3) write(*,*) 'coeff(4)=',C     &        (matcoe.mat(4,ivoif),ivoif=1,ipos,1)C         cell=0.0D0C         do ivoif=1,ipos,1C            cell=cell+matcoe.mat(1,ivoif)C         enddoC         write(*,*) 'sum=',cellC         if(abs(cell-1.0d0) .gt. 1.0d-10)thenCC           It must be true if I just consider Dirichlet B.C.C            call erreur(5)C            goto 9999C         endifC         segdes mlentiC         segdes matcoeC      enddoC      SEGDES MELFLC      SEGSUP MLREST      SEGSUP MLPOSIC      SEGDES MELSOM      SEGSUP MLESOMC      SEGDES MLEPOF      SEGDES MLECOFC      NSOMM=MLEPOI.LECT(/1)      DO I1=1,NSOMM,1         MLENTI=MLEPOI.LECT(I1)         SEGSUP MLENTI         MLREEL=MLECOE.LECT(I1)         SEGSUP MLREEL      ENDDO      SEGSUP MLEPOI      SEGSUP MLECOEC 9999 CONTINUE      RETURN      END

© Cast3M 2003 - Tous droits réservés.
Mentions légales