parini.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\parini.f
00002 !
00070                      SUBROUTINE PARINI
00071 !                    *****************
00072 !
00073      &(NHP,NHM,INDPU,FAC,NPOIN2,NACHB,NPLAN,MESH,NB_NEIGHB,
00074      & NB_NEIGHB_SEG,NELEM2,IFAPAR)
00075 !
00076 !***********************************************************************
00077 ! BIEF   V7P0                                   21/08/2010
00078 !***********************************************************************
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00085 !| FAC              |<--| 1/(NUMBER OF NEIGHBOURING SUB-DOMAINS)
00086 !| IFAPAR           |-->| IFAPAR(1:3,IELEM)=PROCESSOR NUMBERS BEHIND THE
00087 !|                  |   | 3 ELEMENT EDGES  (NUMBERS FROM 0 TO NCSIZE-1)
00088 !|                  |   | IFAPAR(4:6,IELEM): -LOCAL- ELEMENT NUMBERS
00089 !|                  |   | BEHIND THE 3 EDGES
00090 !| INDPU            |<--| INDEX TABLE : IF 0: NOT AN INTERFACE POINT
00091 !|                  |   |               IF NOT 0: ADDRESS IN THE LIST
00092 !|                  |   |               OF BOUNDARY POINTS.
00093 !| MESH             |-->| MESH STRUCTURE
00094 !| NACHB            |-->| IF 'IL' IS THE LOCAL RANK OF A NEIGHBOURING
00095 !|                  |   | SUB-DOMAIN AND 'IP' ONE INTERFACE POINT
00096 !|                  |   | NACHB(IL,IP) WILL BE THE REAL NUMBER OF THIS
00097 !|                  |   | NEIGHBOURING SUB-DOMAIN
00098 !|                  |   | THE LIST IN NACHB IS ORDERED WITH THE
00099 !|                  |   | GLOBAL NUMBERS OF POINTS (HENCE THE POINTS
00100 !|                  |   | WILL BE FOUND IN THE SAME ORDER BY ALL
00101 !|                  |   | PROCESSORS)
00102 !| NB_NEIGHB        |<--| NUMBER OF NEIGHBOURING SUB-DOMAINS (FOR POINTS)
00103 !| NB_NEIGHB_SEG    |<--| NUMBER OF NEIGHBOURING SUB-DOMAINS (FOR EDGES)
00104 !| NB_NEIGHB_PT_SEG |<--| NUMBER OF SEGMENTS SHARED WITH A NEIGHBOUR
00105 !| NELEM2           |-->| NUMBER OF ELEMENTS IN 2D
00106 !| NHM              |<--| NODE NUMBERS OF PROCESSORS WITH SMALLER RANK
00107 !| NHP              |<--| NODE NUMBERS OF PROCESSORS WITH LARGER RANK
00108 !| NPLAN            |-->| NUMBER OF PLANES IN 3D
00109 !| NPOIN2           |-->| NUMBER OF POINTS IN 2D
00110 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00111 !
00112       USE BIEF, EX_PARINI => PARINI
00113       USE DECLARATIONS_TELEMAC, ONLY : MODASS
00114 !
00115       IMPLICIT NONE
00116       INTEGER LNG,LU
00117       COMMON/INFO/LNG,LU
00118 !
00119 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00120 !
00121       INTEGER, INTENT(IN)            :: NPOIN2,NPLAN,NELEM2
00122       INTEGER, INTENT(INOUT)         :: NB_NEIGHB,NB_NEIGHB_SEG
00123       INTEGER, INTENT(INOUT)         :: NHP(NBMAXDSHARE,NPTIR)
00124       INTEGER, INTENT(INOUT)         :: NHM(NBMAXDSHARE,NPTIR)
00125       INTEGER, INTENT(IN)            :: NACHB(NBMAXNSHARE,NPTIR)
00126       INTEGER, INTENT(IN)            :: IFAPAR(6,NELEM2)
00127       INTEGER, INTENT(INOUT)         :: INDPU(NPOIN2)
00128       TYPE(BIEF_OBJ), INTENT(INOUT)  :: FAC
00129       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00130 !
00131 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00132 !
00133       INTEGER IKP(NBMAXDSHARE,2),IKM(NBMAXDSHARE,2)
00134       INTEGER I,J,IL,IZH,II,IMAX,IMIN,ILMAX,IELEM,IFACE
00135       INTEGER ILP,ILM,IPA,IKA,IPB,IKB,NB_PT_MX,DIM1HCOM,CHECKSUM
00136       LOGICAL NEW
00137 !
00138 !-----------------------------------------------------------------------
00139 !
00140 !     INITIALISES THE PROCESSOR NUMBERS FOR 2D MESSAGE-PASSING
00141 !
00142       DO I=1,NBMAXDSHARE
00143         IKP(I,1)=-1
00144         IKM(I,1)=-1
00145         IKP(I,2)=0
00146         IKM(I,2)=0
00147       ENDDO
00148 !
00149 !     PREPARES COMMUNICATION
00150 !     IN THE FOLLOWING SEQUENCE :
00151 !     1) SENDS     TO   PROCESSORS WITH NUMBER IPID + IL
00152 !     2) RECEIVES  FROM PROCESSORS WITH NUMBER IPID - IL
00153 !     3) SENDS     TO   PROCESSORS WITH NUMBER IPID - IL
00154 !     4) RECEIVES  FROM PROCESSORS WITH NUMBER IPID + IL
00155 !
00156 !     LEVEL IL : SENDS AND RECEIVES
00157 !
00158 !
00159 !     SENDS TO PROCESSORS WITH NUMBER GREATER THAN IPID
00160 !
00161       IMAX=IPID
00162 !
00163       IF (IPID.NE.NCSIZE-1) THEN
00164         IZH=1
00165         DO IL=IPID+1,NCSIZE-1
00166           II=0
00167           DO I=1,NPTIR
00168             DO J=2,NBMAXNSHARE
00169               IF(NACHB(J,I).EQ.IL) THEN
00170                 IF(IZH.GT.NBMAXDSHARE) THEN
00171                   IF(LNG.EQ.1) THEN
00172                     WRITE(LU,*) 'PARINI : NBMAXDSHARE TROP PETIT'
00173                   ENDIF
00174                   IF(LNG.EQ.2) THEN
00175                     WRITE(LU,*) 'PARINI: NBMAXDSHARE TOO SMALL'
00176                   ENDIF
00177                   CALL PLANTE(1)
00178                   STOP
00179                 ENDIF
00180                 II=II+1
00181                 NHP(IZH,II)=NACHB(1,I)
00182               ENDIF
00183             ENDDO ! J
00184           ENDDO ! I
00185           IF(II.NE.0) THEN
00186             IKP(IZH,1)=IL
00187             IKP(IZH,2)=II
00188             IZH=IZH+1
00189             IMAX=IL
00190           ENDIF
00191         ENDDO ! IL
00192       ENDIF
00193 !
00194 !
00195 !     RECEIVES FROM PROCESSORS WITH NUMBER LOWER THAN IPID
00196 !
00197       IMIN=IPID
00198 !
00199       IF (IPID.NE.0) THEN
00200         IZH=1
00201         DO IL=IPID-1,0,-1
00202           II=0
00203           DO I=1,NPTIR
00204            DO J=2,NBMAXNSHARE
00205               IF(NACHB(J,I).EQ.IL) THEN
00206                 IF(IZH.GT.NBMAXDSHARE) THEN
00207                   IF(LNG.EQ.1) THEN
00208                     WRITE(LU,*) 'PARINI : NBMAXDSHARE TROP PETIT'
00209                   ENDIF
00210                   IF(LNG.EQ.2) THEN
00211                     WRITE(LU,*) 'PARINI: NBMAXDSHARE TOO SMALL'
00212                   ENDIF
00213                   CALL PLANTE(1)
00214                   STOP
00215                 ENDIF
00216                 II=II+1
00217                 NHM(IZH,II)=NACHB(1,I)
00218               ENDIF
00219             ENDDO ! J
00220           ENDDO ! I
00221           IF(II.NE.0) THEN
00222             IKM(IZH,1)=IL
00223             IKM(IZH,2)=II
00224             IZH=IZH+1
00225             IMIN=IL
00226           ENDIF
00227         ENDDO ! IL
00228       ENDIF
00229 !
00230 !**   DETERMINES ILMAX
00231 !
00232       ILMAX=MAX(IMAX-IPID,IPID-IMIN)
00233 !
00234 !-----------------------------------------------------------------------
00235 !
00236 !====   COMPUTES THE NUMBER OF NEIGHBOURS
00237 !
00238         NB_PT_MX  = 0
00239         NB_NEIGHB = 0
00240         ILP = 1
00241         ILM = 1
00242 !**     PROCESSOR OF HIGHER RANK
00243         DO IL=1,ILMAX
00244           IPA=IKP(ILP,1)
00245           IKA=IKP(ILP,2)
00246           IF(IPA.EQ.IPID+IL.AND.IKA.NE.0) THEN
00247             NB_NEIGHB = NB_NEIGHB + 1
00248             IF(IKA.GT.NB_PT_MX) NB_PT_MX=IKA
00249           ENDIF
00250           IF(IPA.EQ.IPID+IL) ILP=ILP+1
00251         ENDDO
00252 !**      PROCESSOR OF LOWER RANK
00253         DO IL=1,ILMAX
00254           IPB=IKM(ILM,1)
00255           IKB=IKM(ILM,2)
00256           IF(IPB.EQ.IPID-IL.AND.IKB.NE.0) THEN
00257             NB_NEIGHB = NB_NEIGHB + 1
00258             IF(IKB.GT.NB_PT_MX) NB_PT_MX=IKB
00259           ENDIF
00260           IF(IPB.EQ.IPID-IL) ILM=ILM+1
00261         ENDDO
00262 !
00263 !====   ENDS COMPUTATION OF THE NUMBER OF NEIGHBOURS
00264 !
00265         CALL BIEF_ALLVEC(2,MESH%NB_NEIGHB_PT,'NBNGPT',
00266      &                   NB_NEIGHB,1,0,MESH)
00267         CALL BIEF_ALLVEC(2,MESH%LIST_SEND   ,'LSSEND',
00268      &                   NB_NEIGHB,1,0,MESH)
00269 !
00270 ! ALIGNMENT ON 16 BYTES
00271 !
00272         DIM1HCOM = NB_PT_MX/4
00273         IF(MOD(NB_PT_MX,4).EQ.0) THEN
00274           DIM1HCOM = DIM1HCOM*4
00275         ELSE
00276           DIM1HCOM = DIM1HCOM*4 + 4
00277         ENDIF
00278         CALL BIEF_ALLVEC(2,MESH%NH_COM,'NH_COM',
00279      &                   DIM1HCOM,NB_NEIGHB,0,MESH)
00280 !
00281 !====   COMPUTES THE NUMBER OF INTERFACE POINTS PER NEIGHBOUR
00282 !
00283         NB_NEIGHB = 0
00284         ILP = 1
00285         ILM = 1
00286         DO IL=1,ILMAX
00287           IPA=IKP(ILP,1)
00288           IKA=IKP(ILP,2)
00289           IF(IPA.EQ.IPID+IL.AND.IKA.NE.0) THEN
00290             NB_NEIGHB = NB_NEIGHB + 1
00291             MESH%NB_NEIGHB_PT%I(NB_NEIGHB) = IKA
00292             MESH%LIST_SEND%I(NB_NEIGHB) = IPA
00293             DO I=1,IKA
00294               MESH%NH_COM%I(DIM1HCOM*(NB_NEIGHB-1)+I)=NHP(ILP,I)
00295             ENDDO
00296           ENDIF
00297           IF(IPA.EQ.IPID+IL) ILP=ILP+1
00298         ENDDO
00299         DO IL=1,ILMAX
00300           IPB=IKM(ILM,1)
00301           IKB=IKM(ILM,2)
00302           IF(IPB.EQ.IPID-IL.AND.IKB.NE.0) THEN
00303             NB_NEIGHB = NB_NEIGHB + 1
00304             MESH%NB_NEIGHB_PT%I(NB_NEIGHB) = IKB
00305             MESH%LIST_SEND%I(NB_NEIGHB) = IPB
00306             DO I=1,IKB
00307               MESH%NH_COM%I(DIM1HCOM*(NB_NEIGHB-1)+I)=NHM(ILM,I)
00308             ENDDO
00309           ENDIF
00310           IF(IPB.EQ.IPID-IL) ILM=ILM+1
00311         ENDDO
00312 !
00313 !==== ENDS COMPUTATION OF THE NUMBER OF INTERFACE POINTS PER NEIGHBOUR
00314 !
00315 !=== POSSIBILITY OF SORTING LIST_SEND AND RECV FOR TORE BG
00316 !
00317 ! ALIGNMENT ON 16BYTES BOUNDARIES
00318 !
00319         NB_PT_MX = NB_PT_MX * NPLAN
00320         IL = NB_PT_MX/2
00321         IF(MOD(NB_PT_MX,2).EQ.0) THEN
00322           IL = IL*2
00323         ELSE
00324           IL = IL*2 + 2
00325         ENDIF
00326         CALL BIEF_ALLVEC(1,MESH%BUF_SEND,'BUSEND',IL*3,NB_NEIGHB,0,MESH)
00327         CALL BIEF_ALLVEC(1,MESH%BUF_RECV,'BURECV',IL*3,NB_NEIGHB,0,MESH)
00328 !
00329 !       ADDED FOR INTEGER I4 COMMUNICATIONS
00330 !
00331         ALLOCATE(MESH%BUF_SEND%I(IL*3*NB_NEIGHB))
00332         ALLOCATE(MESH%BUF_RECV%I(IL*3*NB_NEIGHB))
00333 !
00334 !       ADDED FOR INTEGER I8 COMMUNICATIONS
00335 !
00336         IF(MODASS.EQ.2) THEN
00337           ALLOCATE(MESH%BUF_SENDI8(IL*3*NB_NEIGHB))
00338           ALLOCATE(MESH%BUF_RECVI8(IL*3*NB_NEIGHB))
00339         ENDIF
00340 !
00341 !-----------------------------------------------------------------------
00342 !
00343 !  JMH: FOR SEGMENTS
00344 !
00345 !     WE ASSUME HERE THAT NB_NEIGHB.GE.NB_NEIGHB_SEG
00346 !
00347 !     NOTE: NH_COM_SEG IS FILLED WITH 4*IELEM+IFACE
00348 !           THIS IS TO RETRIEVE IELEM AND IFACE ONCE ELTSEG IS KNOWN
00349 !           THE FINAL VALUE OF NH_COM_SEG IS ELTSEG(IELEM,IFACE)
00350 !
00351       CALL BIEF_ALLVEC(2,MESH%NB_NEIGHB_PT_SEG,'NBNGSG',
00352      &                 NB_NEIGHB,1,0,MESH)
00353       CALL BIEF_ALLVEC(2,MESH%LIST_SEND_SEG   ,'LSSESG',
00354      &                 NB_NEIGHB,1,0,MESH)
00355       CALL BIEF_ALLVEC(2,MESH%NH_COM_SEG      ,'NH_CSG',
00356      &                 DIM1HCOM,NB_NEIGHB,0,MESH)
00357 !
00358       NB_NEIGHB_SEG=0
00359 !
00360 !     INITIALISES NH_COM_SEG (SEE COMP_NH_COM_SEG)
00361 !
00362       DO I=1,DIM1HCOM*NB_NEIGHB
00363         MESH%NH_COM_SEG%I(I)=-999999
00364       ENDDO
00365 !
00366       DO IELEM=1,NELEM2
00367 !
00368 !       LOOKS FOR A FACE WITH THE OTHER SIDE IN ANOTHER SUB-DOMAIN
00369 !
00370 !       ELEMENTS WITHOUT ANY INTERFACE SEGMENT HAVE 3 ZEROS
00371         CHECKSUM=IFAPAR(1,IELEM)**2+
00372      &           IFAPAR(2,IELEM)**2+
00373      &           IFAPAR(3,IELEM)**2
00374 !
00375         IF(CHECKSUM.NE.0) THEN
00376         DO IFACE=1,3
00377 !
00378           ILM=IFAPAR(IFACE,IELEM)
00379           IF(ILM.GE.0.AND.ILM.NE.IPID) THEN
00380 !           NEW INTERFACE SEGMENT FOUND
00381             IF(NB_NEIGHB_SEG.EQ.0) THEN
00382 !             THE FIRST ONE
00383               NB_NEIGHB_SEG=1
00384               MESH%NB_NEIGHB_PT_SEG%I(1)=1
00385               MESH%LIST_SEND_SEG%I(1)=ILM
00386               MESH%NH_COM_SEG%I(1)=4*IELEM+IFACE
00387             ELSE
00388 !             FROM THE SECOND ON
00389 !             IS IT A NEW PROCESSOR
00390               NEW=.TRUE.
00391               DO IL=1,NB_NEIGHB_SEG
00392                 IF(ILM.EQ.MESH%LIST_SEND_SEG%I(IL)) THEN
00393 !                 NEW SEGMENT, OLD PROCESSOR
00394                   MESH%NB_NEIGHB_PT_SEG%I(IL)=
00395      &            MESH%NB_NEIGHB_PT_SEG%I(IL)+1
00396                   I=MESH%NB_NEIGHB_PT_SEG%I(IL)
00397                   MESH%NH_COM_SEG%I(DIM1HCOM*(IL-1)+I)=4*IELEM+IFACE
00398                   NEW=.FALSE.
00399                   EXIT
00400                 ENDIF
00401               ENDDO
00402               IF(NEW) THEN
00403 !               NEW SEGMENT, NEW PROCESSOR
00404                 NB_NEIGHB_SEG=NB_NEIGHB_SEG+1
00405                 MESH%NB_NEIGHB_PT_SEG%I(NB_NEIGHB_SEG)=1
00406                 MESH%LIST_SEND_SEG%I(NB_NEIGHB_SEG)=ILM
00407                 MESH%NH_COM_SEG%I(DIM1HCOM*(NB_NEIGHB_SEG-1)+1)=
00408      &                            4*IELEM+IFACE
00409               ENDIF
00410             ENDIF
00411           ENDIF
00412 !
00413         ENDDO
00414         ENDIF
00415 !
00416       ENDDO
00417 !
00418       IF(NB_NEIGHB_SEG.GT.NB_NEIGHB) THEN
00419         WRITE(LU,*) 'IN PARINI NB_NEIGHB    =',NB_NEIGHB
00420         WRITE(LU,*) '          NB_NEIGHB_SEG=',NB_NEIGHB_SEG
00421         CALL PLANTE(1)
00422         STOP
00423       ENDIF
00424 !
00425 !-----------------------------------------------------------------------
00426 !
00427 !     COMPUTES THE FACTORS FOR LATER QUADRATIC NORMS
00428 !     IDENTIFIES INTERNAL NODES/PROCESSORS
00429 !     INDEX TABLE FOR BUFFER IN COMMUNICATION
00430 !
00431       DO I=1,NPOIN2
00432         INDPU(I)=0
00433       ENDDO
00434 !
00435       CALL OS( 'X=C      ' ,X=FAC , C=1.D0 )
00436 !
00437 !  COEFFICIENTS FOR THE SCALAR PRODUCT:
00438 !
00439       IF(NPTIR.GT.0) THEN
00440 !
00441         DO I=1,NPTIR
00442 !
00443 !         FAC = 1/(NUMBER OF DOMAINS NEIGHBOURING A POINT)
00444 !         SEE ALSO SUBROUTINE COMP_FAC FOR COMPLETION WITH QUADRATIC
00445 !         ELEMENTS
00446 !
00447           DO J=NBMAXNSHARE,3,-1
00448             IF(NACHB(J,I).EQ.-1) FAC%R(NACHB(1,I))=1.D0/(DBLE(J)-1.D0)
00449           ENDDO
00450 !
00451           INDPU(NACHB(1,I))=I
00452 !
00453         ENDDO
00454 !
00455       ENDIF
00456 !
00457 !-----------------------------------------------------------------------
00458 !
00459       RETURN
00460       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0