pares3d.F

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\partel\pares3d.F
00002 !
00056                         SUBROUTINE PARES3D
00057 !                       ******************
00058 
00059      &(NAMEINP,NAMELOG,NPARTS,PMETHOD,FORMAT_MED)
00060 !
00061 !**********************************************************************
00062 !  12/11/2009 CHRISTOPHE DENIS SINETICS/I23
00063 !  NEW VERSION TO DECREASE THE PARES3D COMPUTING TIME BY IMPROVING
00064 !
00065 !   - THE TETRA-TRIA CONNECTION
00066 !   - THE POSTPROCESSING
00067 !
00068 ! COMMENTS ON THIS NEW VERSION ->  CD
00069 ! *********************************************************************
00070 !***********************************************************************
00071 ! PARTEL VERSION 5.6        08/06/06   O.BOITEAU/F.DECUNG(SINETICS/LNHE)
00072 ! PARTEL VERSION 5.8        02/07/07   F.DECUNG(LNHE)
00073 ! VERSION DE DEVELOPPEMENT POUR PRISE EN COMPTE PB DECOUPAGE
00074 ! F.DECUNG/O.BOITEAU (JANV 2008)
00075 ! AJOUT LECTURE DU FORMAT MED (SEPT 2013) V.STOBIAC
00076 ! COPYRIGHT 2006
00077 !***********************************************************************
00078 !
00079 !    CONSTRUCTIONS DES FICHIERS POUR ALIMENTER LE FLOT DE DONNEES
00080 !    PARALLELE LORS D'UN CALCUL ESTEL3D PARALLELE EN ECOULEMENT
00081 !
00082 !
00083 !-----------------------------------------------------------------------
00084 !                             ARGUMENTS
00085 ! .________________.____.______________________________________________.
00086 ! |      NOM       |MODE|                   ROLE                       |
00087 ! |________________|____|______________________________________________|
00088 ! |    NAMEINP     | -->| NOM DU FICHIER DE GEOMETRIE ESTEL3D
00089 ! |    NAMELOG     | -->| NOM DU FICHIER LOG
00090 ! |    NPARTS      | -->| NOMBRE DE PARTITION
00091 ! |    PMETHOD     | -->| METHODE DE PARTITIONEMENT 1 metis 2 scotch
00092 ! |    FORMAT_MED  | -->| BOULEEN POUR LE MAILLAGE AU FORMAT MED
00093 ! |________________|____|______________________________________________|
00094 !  MODE: -->(DONNEE NON MODIFIEE),<--(RESULTAT),<-->(DONNEE MODIFIEE)
00095 !
00096 !-----------------------------------------------------------------------
00097 !
00098 ! APPELE PAR :  PARTEL
00099 !
00100 ! SOUS-PROGRAMME APPELE :
00101 !        PARTEL_ALLOER, PARTEL_ALLOER2 (GESTION MSGS)
00102 !        METIS_PARTMESHDUAL (FROM METIS LIBRARY)
00103 !***********************************************************************
00104 !
00105 !     BEGIN MODIF V STOBIAC
00106       USE DECLARATIONS_PARTEL
00107       USE UTIL_PARES
00108       USE M_MED
00109 !     END MODIF V STOBIAC
00110 
00111       IMPLICIT NONE
00112 !
00113       INTEGER LNG,LU
00114       COMMON/INFO/LNG,LU
00115 !
00116 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00117 !
00118       CHARACTER(LEN=MAXLENHARD), INTENT(IN) :: NAMEINP
00119       CHARACTER(LEN=MAXLENHARD), INTENT(IN) :: NAMELOG
00120       INTEGER,                   INTENT(IN) :: NPARTS
00121       INTEGER,                   INTENT(IN) :: PMETHOD
00122       LOGICAL,                   INTENT(IN) :: FORMAT_MED
00123 !
00124 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00125 !
00126 !
00127 ! VARIABLES LOCALES
00128       CHARACTER(LEN=MAXLENHARD) :: NAMEINP2,NAMELOG2
00129       INTEGER :: NINP=10,NLOG=11,NINP2=12,NLOG2=13
00130       INTEGER :: I_S,I_SP,I,I_LEN,I_LENINP,IERR,J,K,COMPT,
00131      &           N,NUMTET,NUMTRI,NUMTRIG,I_LENLOG,L,NI,NF,NT,IBID,IDD,
00132      &           COMPT1,COMPT2,COMPT3,NBTRIIDD,M,COLOR1,
00133      &           COLOR2,PR1,PR2,NBTETJ,IDDNT,NIT,NFT,MT,
00134      &           NUMTRIB,NUMTETB,IBIDC,NBRETOUCHE,INDPU(1)
00135       LOGICAL :: IS,LINTER
00136       CHARACTER(LEN=300) :: TEXTERROR  ! TEXTE MSG D'ERREUR
00137       CHARACTER(LEN=8)   :: STR8       ! TEXTE MSG D'ERREUR
00138       CHARACTER(LEN=300) :: STR26      ! TEXTE MSG D'ERREUR
00139       CHARACTER(LEN=80)  :: TITRE      ! MESH TITLE IN THE FILE
00140       CHARACTER(LEN=2)   :: MOINS1     ! "-1"
00141       CHARACTER(LEN=4)   :: BLANC      ! WHITE SPACE
00142 
00143       ! ADDITION JP RENAUD 15/02/2007
00144       CHARACTER(LEN=200) :: LINE       ! ONE LINE, 200 CHARACTERS MAXADDCH
00145       INTEGER            :: POS        ! POSITION OF A CHARACTER IN THE LINE
00146       INTEGER            :: IOS        ! STATUS INTEGER
00147       ! END ADDITION JP RENAUD
00148       CHARACTER(LEN=72) :: THEFORMAT
00149 
00150       CHARACTER(LEN=80), ALLOCATABLE :: LOGFAMILY(:)  ! LOG INFORMATIONS
00151       INTEGER            :: NSEC       ! TYPE OF THE SECTION READ
00152       INTEGER, PARAMETER :: NSEC1=151  ! MESH TITLE SECTION ID
00153       INTEGER, PARAMETER :: NSEC2=2411 ! NODES COORDINATES SECTION ID
00154       INTEGER, PARAMETER :: NSEC3=2412 ! CONNECTIVITY SECTION ID
00155       LOGICAL            :: READ_SEC1  ! FLAG FOR READING SECTION 1
00156       LOGICAL            :: READ_SEC2  ! FLAG FOR READING SECTION 2
00157       LOGICAL            :: READ_SEC3  ! FLAG FOR READING SECTION 3
00158       INTEGER            :: NELEMTOTAL ! TOTAL NUMBER OF UNV ELEMENTS
00159       INTEGER            :: NPOINT     ! TOTAL NUMBER OF NODES
00160       INTEGER            :: NBFAMILY   ! TOTAL NUMBER OF FAMILY
00161       INTEGER            :: NELIN      ! TOTAL NUMBER OF INNER TRIANGLES
00162       INTEGER            :: SIZE_FLUX  !  TOTAL NUMBER OF INNER SURFACES
00163       INTEGER, DIMENSION(:), ALLOCATABLE :: VECTNB  ! VECTEUR AUX POUR NACHB
00164 
00165       ! BEGIN MODIF V STOBIAC
00166       ! FORMAT MED
00167       INTEGER, PARAMETER :: MDIM=3  ! MESH DIMENSION (EXPECTED WITH ESTEL)
00168 
00169       CHARACTER(LEN=16), DIMENSION(MDIM) :: NAMECOOR, UNITCOOR  ! NOM ET UNITE DES COORDONNES
00170       CHARACTER(LEN=16)                  :: DATA_TEMP
00171       CHARACTER(LEN=43)                  :: TYPE_INPUT
00172       CHARACTER(LEN=43)                  :: TXT, TXT_OLD
00173 #if defined (HAVE_MED)
00174       CHARACTER(LEN=MED_NAME_SIZE),DIMENSION(:),ALLOCATABLE :: FAM
00175       CHARACTER(LEN=MED_NAME_SIZE)       :: VERSION             ! VERSION OF THE MED FILE
00176       CHARACTER(LEN=MED_NAME_SIZE)       :: MESH_NAME           ! CURRENT MESH NAME
00177       CHARACTER(LEN=MED_NAME_SIZE)       :: DTUNIT              ! TIME STEP UNIT
00178       CHARACTER(LEN=MED_COMMENT_SIZE)    :: DESC                ! MESH DESCRIPTION
00179       CHARACTER(LEN=MED_LNAME_SIZE),DIMENSION(:),ALLOCATABLE ::
00180      &       GR_FAMILY
00181 #endif
00182       CHARACTER, DIMENSION(:), ALLOCATABLE :: DUMNAME
00183 
00184       LOGICAL :: HDFOK, MEDOK  ! CHECK COMPATIBILITY
00185       LOGICAL :: FOUND
00186 
00187       INTEGER :: CRET               ! ERROR CODE
00188       INTEGER :: NBTRI2             ! TOTAL NB OF TRIANGLE(INNER AND BOUNDARY)
00189       INTEGER :: NDIM               ! DIMENSION OF THE PB (3)
00190       INTEGER :: MAJOR, MINOR, REL  ! MED VERSION OF THE FILE
00191       INTEGER :: NBMESH             ! TOTAL NUMBER OF MESH
00192       INTEGER :: IDUM, NUM          ! DUMMY
00193       INTEGER :: STYPE              ! MESH TYPE (CARTESIAN, UNSTRUCTURED)
00194       INTEGER :: NBGRF
00195       INTEGER :: FID                ! FILE DESCRIPTOR FOR THE MED FILE
00196       INTEGER :: NBFAMILY2          ! TEMPORARY NUMBER OF FAMILY
00197       INTEGER, DIMENSION(:), ALLOCATABLE :: DUMNUM
00198       INTEGER, DIMENSION(:), ALLOCATABLE :: IKLESTRI2
00199       INTEGER, DIMENSION(:), ALLOCATABLE :: NUFATRIA, NUFATRIA2   ! TRIANGLE COLOR
00200       INTEGER, DIMENSION(:), ALLOCATABLE :: NUFATETRA  ! TETRAHEDRA COLOR
00201       INTEGER, DIMENSION(:), ALLOCATABLE :: NUFANO     ! NODES COLOR
00202       INTEGER, DIMENSION(:), ALLOCATABLE :: FF_BNODE
00203       INTEGER, DIMENSION(:,:), ALLOCATABLE :: ID_CHANGE_LOG
00204       INTEGER, DIMENSION(:,:), ALLOCATABLE :: ID_CHANGE_LOG2
00205 
00206       DOUBLE PRECISION, ALLOCATABLE :: COOR(:) ! COORD NODES
00207 
00208       INTEGER :: PTET1,PTET2,PTET3,DEB1,FIN1,DEB2,FIN2,DEB3,FIN3
00209       INTEGER :: PTET4,PTRI1,PTRI2,PTRI3
00210       LOGICAL :: FOUND_TET
00211 
00212       ! END MODIF V STOBIAC
00213 
00214       DOUBLE PRECISION, ALLOCATABLE :: X1(:),Y1(:),Z1(:) ! COORD NODES
00215       INTEGER,          ALLOCATABLE :: ECOLOR(:) ! ELEMENTS' COLOUR
00216       INTEGER            :: ELEM       ! TYPE OF THE ELEMENT
00217       INTEGER            :: IKLE1,IKLE2,IKLE3,IKLE4,IKLEB   ! NODES
00218       INTEGER, DIMENSION(:), ALLOCATABLE :: IKLESTET ! CONNECTIVITE EN
00219                    ! RENUMEROTATION GLOBAL DE LA BIEF POUR LES TETRAEDRES
00220       INTEGER, DIMENSION(:), ALLOCATABLE :: IKLESTRI ! CONNECTIVITE EN
00221                    ! RENUMEROTATION GLOBAL DE LA BIEF POUR LES TRIANGLES
00222       INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLESTRIN ! CONNECTIVITE EN
00223                    ! RENUMEROTATION GLOBAL DE LA BIEF POUR LES TRIANGLES
00224       INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLEIN ! COPIE AJUSTEE DE IKLESTRIN
00225       INTEGER, DIMENSION(:,:), ALLOCATABLE :: TYPELEM ! TYPE D'ELT
00226       INTEGER            :: NBTET,NBTRI  ! NBRE DE TETRA, TRIANGLE BORD
00227       INTEGER, DIMENSION(:), ALLOCATABLE :: TETTRI, TETTRI2 ! JOINTURE
00228                                                !  TETRA/TRIANGLE DE BORD
00229       INTEGER, DIMENSION(:), ALLOCATABLE :: EPART ! NUMERO DE PARTITION
00230                                                   ! PAR ELEMENT
00231       INTEGER, DIMENSION(:), ALLOCATABLE :: NPART ! NUMERO DE PARTITION
00232                                                   ! PAR NOEUDS
00233       INTEGER, DIMENSION(:), ALLOCATABLE :: CONVTRI ! CONVERTISSEUR
00234       ! NUMERO LOCAL TRIA/TETRA NUMERO GLOBAL; INVERSE DE TYPELEM(:,2)
00235       INTEGER            ::  PARSEC  ! RUNTIME
00236       INTEGER, DIMENSION(:), ALLOCATABLE :: NPOINTSD, NELEMSD ! NBRE
00237       ! DE POINTS ET D'ELEMENTS PAR SOUS-DOMAINE
00238       INTEGER, DIMENSION(:), ALLOCATABLE :: NPOINTISD  ! NBRE
00239       ! DE POINTS D'INTERFACE PAR SOUS-DOMAINE
00240       ! VECTEURS LIES AUX CONNECTIVITEES NODALES INVERSES
00241       INTEGER, DIMENSION(:), ALLOCATABLE :: NODES1,NODES2,NODES3,NODES4
00242       INTEGER, DIMENSION(:), ALLOCATABLE :: NODES1T,NODES2T,NODES3T
00243       INTEGER, DIMENSION(:), ALLOCATABLE :: TRIUNV ! BUFFER POUR ECRIRE
00244                  ! DANS LES .UNV, D'ABORD LES TETRAS PUIS LES TRIA
00245 ! POUR TRAITEMENT DES DIRICHLETS CONFONDUS AVEC L'INTERFACE
00246       INTEGER  :: NBCOLOR ! NBRE DE COULEUR DE MAILLES EXTERNES
00247       INTEGER, DIMENSION(:), ALLOCATABLE :: PRIORITY
00248       INTEGER, DIMENSION(:), ALLOCATABLE :: NCOLOR,NCOLOR2
00249 ! POUR TRAITEMENT DES DIRICHLETS SUR LES NOEUDS DE TETRA
00250       LOGICAL, DIMENSION(:,:), ALLOCATABLE :: TETCOLOR
00251       LOGICAL, DIMENSION(:), ALLOCATABLE :: DEJA_TROUVE
00252 ! INDISPENSABLE POUR PARALLELISME TELEMAC
00253       INTEGER, DIMENSION(:), ALLOCATABLE :: KNOLG
00254       INTEGER, DIMENSION(:,:), ALLOCATABLE :: NACHB
00255       LOGICAL :: NACHBLOG
00256 !     MAXIMUM GEOMETRICAL MULTIPLICITY OF A NODE (VARIABLE AUSSI
00257 !     PRESENTE DANS LA BIEF, NE PAS CHANGER L'UNE SANS L'AUTRE)
00258       INTEGER, PARAMETER :: NBMAXNSHARE =  10
00259 ! CETTE VARIABLE EST LIEE A LA PRECEDENTE ET DIMENSIONNE DIFFERENTS
00260 ! VECTEURS
00261 ! NOTE SIZE OF NACHB WILL BE HERE 2 MORE THAN IN BIEF, BUT THE EXTRA 2 ARE
00262 ! LOCAL WORK ARRAYS
00263       INTEGER :: NBSDOMVOIS = NBMAXNSHARE + 2
00264 !
00265       INTEGER, PARAMETER :: MAX_SIZE_FLUX = 99
00266 ! NUMBER OF INNER SURFACE (SAME AS SIZE_FLUX AT THE END)
00267       INTEGER, DIMENSION(MAX_SIZE_FLUX) :: SIZE_FLUXIN
00268 ! VECTEUR POUR PROFILING
00269       INTEGER  TEMPS_SC(20)
00270 !
00271 !F.D
00272       INTEGER, DIMENSION(:  ), ALLOCATABLE  :: TEMPO,GLOB_2_LOC
00273       INTEGER, DIMENSION(:,:), ALLOCATABLE  :: IKLES,IKLE,IFABOR
00274       INTEGER, DIMENSION(:,:), ALLOCATABLE  :: NULONE,IKLBOR
00275       INTEGER                               :: N1,N2,N3,IKL
00276       INTEGER                               :: NSOLS,NSOLS_OLD
00277       INTEGER                               :: IELEM,IPTFR,IELEB
00278       LOGICAL, DIMENSION(:), ALLOCATABLE    :: FACE_CHECK
00279       INTEGER, PARAMETER                    :: NCOL = 256
00280       INTEGER, DIMENSION(NCOL  )            :: COLOR_PRIO
00281       INTEGER                               :: PRIO_NEW,NPTFR
00282       INTEGER, DIMENSION(:), ALLOCATABLE    :: NBOR2,NBOR
00283       INTEGER, DIMENSION(:), ALLOCATABLE    :: NELBOR,LIHBOR
00284 
00285 !D******************************************************    ADDED BY CHRISTOPHE DENIS
00286       INTEGER, DIMENSION(:), ALLOCATABLE     :: NELEM_P
00287 !     SIZE NPARTS, NELEM_P(I) IS THE NUMBER OF FINITE ELEMENTS ASSIGNED TO SUBDOMAIN I
00288       INTEGER, DIMENSION(:), ALLOCATABLE     :: NPOIN_P
00289 !     SIZE NPARTS, NPOIN_P(I) IS THE NUMBER OF NODES  ASSIGNED TO SUBDOMAIN I
00290       INTEGER :: NODE
00291 !     ONE NODE ...
00292       INTEGER ::  POS_NODE
00293 !     POSITION OF ONE ONE NODE
00294       INTEGER :: MAX_NELEM_P
00295 !     MAXIMUM NUMBER OF FINITE ELEMENTS ASSIGNED AMONG SUBDOMAINS
00296       INTEGER :: MAX_NPOIN_P
00297 !     MAXIMUM NUMBER OF NODES ASSIGNED AMONG SUBDOMAINS
00298       INTEGER :: MAX_TRIA
00299 !     MAXIMUM NUMBER OF TRIANGLE SHARING A NODE
00300       INTEGER :: THE_TRI
00301 !     ONE TRIANGLE
00302       INTEGER :: JJ
00303 !     INDEX COUNTER
00304       INTEGER, DIMENSION(:), ALLOCATABLE :: NUMBER_TRIA
00305 !     MAXIMUM NUMBER OF TRIANGLE SHARING A SAME NODE
00306       INTEGER, DIMENSION(:,:), ALLOCATABLE  :: ELEGL
00307 !     SIZE MAX_NELEM_P,NPARTS, ELEGL(J,I) IS THE GLOBAL NUMBER OF LOCAL FINITE ELEMENT J IN SUBDOMAIN I
00308       INTEGER, DIMENSION(:,:), ALLOCATABLE :: NODEGL
00309 !     SIZE MAX_NPOIN_P,NPARTS, NODEGL(J,I) IS THE GLOBAL NUMBER OF LOCAL NODE J IN SUBDOMAIN I
00310       INTEGER, DIMENSION(:,:), ALLOCATABLE :: NODELG
00311 !     SIZE NPOINT, NODELG(J,I)=J, IS THE LOCAL NUMBER OF GLOBAL NODE J ON SUBDOMAIN I
00312       INTEGER,  DIMENSION(:,:), ALLOCATABLE :: TRI_REF
00313 !     SIZE NPOINT*MAX_TRIA
00314 !     EXTENS
00315       CHARACTER(LEN=11) :: EXTENS
00316       EXTERNAL EXTENS
00317 !D********************************************************
00318       INTEGER SOMFAC(3,4)
00319       DATA SOMFAC / 1,2,3 , 4,1,2 , 2,3,4 , 3,4,1  /
00320 !
00321 !-------------
00322 ! 1. PREAMBULE
00323 !-------------
00324 !
00325       CALL SYSTEM_CLOCK(COUNT=TEMPS_SC(1),COUNT_RATE=PARSEC)
00326       ALLOCATE (VECTNB(NBSDOMVOIS-3))
00327       WRITE(LU,*)' '
00328       WRITE(LU,*)'+-------------------------------------------------+'
00329       WRITE(LU,*)'  PARTEL: TELEMAC ESTEL3D PARTITIONER'
00330       WRITE(LU,*)'+-------------------------------------------------+'
00331       WRITE(LU,*)' READING UNV AND LOG FILES'
00332 !
00333 !     WRITE FILE FORMAT AND TEST MED LIBRARY
00334       IF (FORMAT_MED) THEN
00335 #if defined (HAVE_MED)
00336         WRITE(LU,*) 'MED FORMAT IS USED FOR THE MESH'
00337 #else
00338         WRITE(LU,*) 
00339 'ERROR: MED FORMAT IS USED FOR THE MESH BUT MED     & LIBRARY IS NOT INSTALLED'
00340         CALL PLANTE(1)
00341         STOP
00342 #endif
00343       ELSE
00344         WRITE(LU,*) 'UNV FORMAT IS USED FOR THE MESH'
00345       ENDIF
00346 
00347 !     OPEN THE MESH FILE (MED)
00348 #if defined (HAVE_MED)
00349       IF (FORMAT_MED) THEN
00350 
00351         ! CHECK IF THE FILE IS BOTH A MED & HDF5 FILE
00352         CALL MFICOM (NAMEINP, HDFOK, MEDOK, CRET)
00353         CALL MED_CHECK_CRET(CRET,'MFICOM')
00354 
00355         IF (.NOT.HDFOK) WRITE(LU,*)'MESH FILE NOT COMPATIBLE WITH HDF5'
00356         IF (.NOT.MEDOK) WRITE(LU,*)'MESH FILE NOT COMPATIBLE WITH MED'
00357 
00358         ! OPEN
00359         CALL MFIOPE(FID, NAMEINP, MED_ACC_RDONLY, CRET)
00360         CALL MED_CHECK_CRET(CRET,'MFIOPE')
00361 
00362         ! PRINT THE MED VERSION OF THE FILE
00363         CALL MFISVR (FID, VERSION, CRET)
00364         CALL MED_CHECK_CRET(CRET,'MFISVR')
00365         WRITE(LU,*) 'MED VERSION OF THE MESH FILE : '// TRIM(VERSION)
00366 
00367         ! CHECK COMPATIBILITY (EXPECTED)
00368         CALL MFINVR (FID, MAJOR, MINOR, REL, CRET)
00369         CALL MED_CHECK_CRET(CRET,'MFINVR')
00370         IF (MAJOR.LT.3) WRITE(LU,*) 'MED FILE IS TOO ''OLD'' (' //
00371      &     TRIM(VERSION) // ') => PLEASE CONVERT IT WITH MEDIMPORT '
00372       END IF
00373 #endif
00374 
00375 !     OPEN THE MESH FILE (UNV)
00376       IF (.NOT.FORMAT_MED) THEN
00377         OPEN(NINP,FILE=NAMEINP,STATUS='OLD',FORM='FORMATTED',ERR=131)
00378         REWIND(NINP)
00379       ENDIF
00380 
00381 !     OPEN THE COMPLEMENTARY FILE
00382       OPEN(NLOG,FILE=NAMELOG,STATUS='OLD',FORM='FORMATTED',ERR=130)
00383       REWIND(NLOG)
00384 !     END MODIF V STOBIAC
00385 
00386 !----------------------------------------------------------------------
00387 ! 2A. LECTURE DU FICHIER .LOG
00388 !---------------
00389 ! The first line contains the number of nodes after a text descriptor.
00390 ! We read a line, locate the colon ':' to then read the number.
00391       READ(UNIT=NLOG, FMT='(A200)', IOSTAT=IOS) LINE
00392       IF (IOS .NE. 0) THEN
00393         WRITE(LU, *) 'ERROR READING THE MESH COMPLEMENTARY FILE.'
00394         CALL PLANTE(1)
00395       ENDIF
00396       POS =INDEX(LINE,':') + 1
00397       READ(UNIT=LINE(POS:),FMT=*, IOSTAT=IOS) NPOINT
00398       IF (IOS .NE. 0) THEN
00399         WRITE(LU,*) 'FORMAT ERROR READING THE MESH COMPLEMENTARY FILE.'
00400         CALL PLANTE(1)
00401       ENDIF
00402 
00403 ! The second line contains the number of elements after a text descriptor.
00404 ! We read a line, locate the colon ':' and then read the number.
00405       READ(UNIT=NLOG, FMT='(A200)', IOSTAT=IOS) LINE
00406       IF (IOS .NE. 0) THEN
00407         WRITE(LU,*)'ERROR READING THE MESH COMPLEMENTARY FILE.'
00408         CALL PLANTE(1)
00409       ENDIF
00410       POS =INDEX(LINE,':') + 1
00411       READ(UNIT=LINE(POS:),FMT=*, IOSTAT=IOS) NELEMTOTAL
00412       IF (IOS .NE. 0) THEN
00413         WRITE(LU,*)'FORMAT ERROR READING THE MESH COMPLEMENTARY FILE.'
00414         CALL PLANTE(1)
00415       ENDIF
00416 !
00417 !     The third line contains the number of families after a text descripto.
00418 !     We read a line, locate the colon ':' and then read the number.
00419       READ(UNIT=NLOG, FMT='(A200)', IOSTAT=IOS) LINE
00420       IF (IOS .NE. 0) THEN
00421         WRITE(LU,*)'ERROR READING THE MESH COMPLEMENTARY FILE.'
00422         CALL PLANTE(1)
00423       ENDIF
00424       POS =INDEX(LINE,':') + 1
00425       READ(UNIT=LINE(POS:),FMT=*, IOSTAT=IOS) NBFAMILY
00426       IF (IOS .NE. 0) THEN
00427         WRITE(LU,*)'FORMAT ERROR READING THE MESH COMPLEMENTARY FILE.'
00428         CALL PLANTE(1)
00429       ENDIF
00430 
00431 !     BEGIN MODIF V STOBIAC
00432 !     READ FAMILIES
00433 #if defined (HAVE_MED)
00434       IF (FORMAT_MED) THEN
00435         ! IGNORE NBFAMILY+1 LINES
00436         DO I=1,NBFAMILY+1
00437           READ(UNIT=NLOG, FMT='(A200)', IOSTAT=IOS) LINE
00438           IF (IOS .NE. 0) THEN
00439             WRITE(LU,*)'! PROBLEM WITH THE NUMBER OF FAMILY!'
00440           ENDIF
00441         ENDDO
00442       END IF
00443 #endif
00444 
00445       IF (.NOT.FORMAT_MED) THEN
00446         NBFAMILY=NBFAMILY+1       ! POUR TITRE DU BLOC
00447         ALLOCATE(LOGFAMILY(NBFAMILY),STAT=IERR)
00448         CALL CHECK_ALLOCATE(IERR,' LOGFAMILY')
00449         DO I=1,NBFAMILY
00450           READ(NLOG,50,ERR=111,END=120)LOGFAMILY(I)
00451         ENDDO
00452       ENDIF
00453 !     END MODIF V STOBIAC
00454 
00455       READ(UNIT=NLOG, FMT='(A200)', IOSTAT=IOS) LINE
00456       IF (IOS .NE. 0) THEN
00457         WRITE(LU,*)'! PROBLEM WITH THE NUMBER OF COLOR !'
00458         CALL PLANTE(1)
00459       ENDIF
00460       POS = INDEX(LINE,':') + 1
00461       READ(UNIT=LINE(POS:), FMT=*, IOSTAT=IOS) NBCOLOR
00462       IF (IOS .NE. 0) THEN
00463         WRITE(LU,*)'! PROBLEM WITH THE NUMBER COLOR !'
00464       ENDIF
00465 
00466       ALLOCATE(PRIORITY(NBCOLOR),STAT=IERR)
00467       CALL CHECK_ALLOCATE(IERR,' PRIORITY')
00468       WRITE(LU,92) NPOINT
00469       WRITE(LU,93) NELEMTOTAL
00470       WRITE(LU,94) NBCOLOR
00471       IF (NBCOLOR.EQ.0) THEN
00472         WRITE(LU,*) 'VOUS AVEZ OUBLIE DE REMPLIR LE FICHIER LOG...'
00473         CALL PLANTE(1)
00474         STOP
00475       ENDIF
00476 
00477       ! MODIFICATION JP RENAUD 15/02/2007
00478       ! SOME TEXT HAS BEEN ADDED BEFORE THE LIOST OF PRIORITIES.
00479       ! READ A 200 CHARACTER LINE, FIND THE ':' AND THEN
00480       ! READ THE VALUES AFTER THE ':'
00481       READ(UNIT=NLOG, FMT='(A200)', IOSTAT=IOS) LINE
00482       IF (IOS .NE. 0) THEN
00483         !         '!------------------------------------------!'
00484         WRITE(LU,*)'! PROBLEM WITH THE PRIORITY OF COLOR NODES !'
00485         CALL PLANTE(1)
00486       ENDIF
00487 
00488       POS = INDEX(LINE,':') + 1
00489       READ(UNIT=LINE(POS:), FMT=*, IOSTAT=IOS) (PRIORITY(J),J=1,NBCOLOR)
00490       IF (IOS .NE. 0) THEN
00491         !         '!------------------------------------------!'
00492         WRITE(LU,*)'! PROBLEM WITH THE PRIORITY OF COLOR NODES !'
00493         CALL PLANTE(1)
00494       ENDIF
00495       ! END MODIFICATION JP RENAUD
00496       WRITE(LU,*) (PRIORITY(J),J=1,NBCOLOR)
00497       CLOSE(NLOG)
00498 !
00499 ! 2B. ALLOCATIONS MEMOIRES ASSOCIEES
00500 !---------------
00501 
00502 !D    ****************************** ALLOCATION MEMORY ADDED BY CD
00503       ALLOCATE(NELEM_P(NPARTS),STAT=IERR)
00504       CALL CHECK_ALLOCATE(IERR,'NELEM_P')
00505       ALLOCATE(NPOIN_P(NPARTS),STAT=IERR)
00506       CALL CHECK_ALLOCATE(IERR,'NPOIN_P')
00507 !D    *******************************
00508 
00509 !     BEGIN MODIF VSTOBIAC
00510 !     READ THE MESH FILE (MED)
00511 #if defined (HAVE_MED)
00512       IF (FORMAT_MED) THEN
00513 
00514         ! DEBUG MODE : FOR DEBUGGING CRASH IN MED ROUTINES
00515         ! READING THE NUMBER OF MESH IN THE FILE
00516         CALL MMHNMH(FID, NBMESH, CRET)
00517         CALL MED_CHECK_CRET(CRET,'MMHNMH')
00518         IF (NBMESH .NE. 1) WRITE(LU,*)'! ONLY ONE MESH EXPECTED !'
00519 
00520         ! LECTURE DES INFOS SUR LE MAILLAGE
00521         CALL MMHMII(FID,1,MESH_NAME,NDIM,IDUM,STYPE,DESC,DTUNIT,IDUM,
00522      &              IDUM,IDUM,NAMECOOR,UNITCOOR,CRET)
00523         CALL MED_CHECK_CRET(CRET,'MMHMII')
00524 
00525         ! GET NUMBER OF FAMILIES IN THE MESH
00526         CALL MFANFA(FID,MESH_NAME,NBFAMILY2,CRET)
00527         CALL MED_CHECK_CRET(CRET,'MFANFA')
00528 
00529         ! AND THEN ALLOCATE...
00530         ALLOCATE (FAM(NBFAMILY2))
00531 
00532         ! READING FAMILIES, GROUPS, ATTRIBUTES IN THE MESH
00533         ALLOCATE(ID_CHANGE_LOG2(NBFAMILY2,2))
00534         ID_CHANGE_LOG2 = 0
00535         NBFAMILY = 0
00536 
00537         DO I=1,NBFAMILY2
00538           ! THERE CAN BE MORE THAN ONE GROUP
00539           ! WE CONSIDER THERE ARE AT MAX 10 GROUPS
00540           !
00541           ! GET THE NUMBER OF GROUPS IN THE FAMILIY
00542           CALL MFANFG (FID,MESH_NAME,I,NBGRF,CRET)
00543           CALL MED_CHECK_CRET(CRET,'MFANFG')
00544 
00545           IF (NBGRF.NE.0) THEN
00546             !
00547             ! AND THEN ALLOCATE...
00548             ALLOCATE(GR_FAMILY(NBGRF))
00549             !
00550             ! /! MED 3 ONLY !\ : GETTING INFORMATION FOR THE FAMILY
00551             CALL MFAFAI(FID,MESH_NAME,I,FAM(I),NUM,GR_FAMILY,
00552      &                  CRET)
00553             CALL MED_CHECK_CRET(CRET,'MFAFAI')
00554             !
00555             ! WARNING (ASSUMPTION) : WE EXPECT ONLY 1 GROUP PER FAMILY...
00556             ! WARNING (ASSUMPTION) : SYNTAX EXPECTED : <COLOR_ID>:<NAME_GROUP>
00557             POS = INDEX(GR_FAMILY(1),':')-1
00558             !
00559             !     BEGIN MODIF V STOBIAC
00560             IF ((POS.LT.1).OR.(POS.GT.3)) THEN
00561               ! COULD BE AN ERROR OR A GROUP OF NODE
00562               ! (MAY HAPPEN WHEN THE MED FILE IS EXPORTED FROM AN UNV FILE)
00563               POS = 0
00564               NSOLS = -99
00565 
00566 !              WRITE(LU,*)'WARNING : ERROR WHEN READING GROUP NUMBER'
00567 !     &                // GR_FAMILY(1)//' SYNTAX : <COLOR_ID>:'
00568 !     &                // '<NAME_GROUP>'
00569 
00570             ELSE
00571               !
00572               ! THE FORMAT IS ADAPTED TO POS IN ORDER TO
00573               ! PREVENT PROBLEMS ON THE BGQ CLUSTER
00574               READ(GR_FAMILY(1)(1:POS),FMT='(i'//ACHAR(48+POS)//')',
00575      &          IOSTAT=IOS) NSOLS
00576               !     END MODIF V STOBIAC
00577               IF (IOS.NE.0) THEN
00578                 NSOLS = -99
00579 !                WRITE(LU,*)'CONVERTING ERROR, FROM GROUP:'//
00580 !     &               TRIM(GR_FAMILY(1))//'TO COLOR:',NSOLS
00581               ENDIF
00582             ENDIF
00583             !
00584             ! TABLE FOR INDEXING MED_ID (INTERN TO MED) TO USER'S COLOR
00585             ID_CHANGE_LOG2(I,1) = NSOLS
00586             ID_CHANGE_LOG2(I,2) = NUM
00587             !
00588             ! COUNT THE NUMBER OF USEFULL FAMILY
00589             IF ((NSOLS.NE.-99).AND.(NSOLS.GT.0))
00590      &        NBFAMILY = NBFAMILY + 1
00591             DEALLOCATE(GR_FAMILY)
00592           ENDIF
00593         ENDDO
00594 
00595         ! PRINT A SUMMARY
00596         PRINT*,'NBFAMILY2',NBFAMILY2
00597         DO I=1,NBFAMILY2
00598           WRITE(LU,*) 'MED_ID=',ID_CHANGE_LOG2(I,2),
00599      &         ' <==> NCOLOR_ID=',ID_CHANGE_LOG2(I,1)
00600         ENDDO
00601 
00602         ! CORRECTION OF ID_CHANGE_LOG TO ERASE USELESS FAMILY
00603         ALLOCATE(ID_CHANGE_LOG(NBFAMILY,2))
00604         J = 0
00605         DO I = 1, NBFAMILY2
00606           NSOLS = ID_CHANGE_LOG2(I,1)
00607           IF ((NSOLS.NE.-99).AND.(NSOLS.GT.0)) THEN
00608             J = J + 1
00609             ID_CHANGE_LOG(J,:) = ID_CHANGE_LOG2(I,:)
00610           ENDIF
00611         ENDDO
00612         DEALLOCATE(ID_CHANGE_LOG2)
00613         DEALLOCATE(FAM)
00614 
00615         ! PRINT A SUMMARY
00616         PRINT*,'NBFAMILY',NBFAMILY
00617         DO I=1,NBFAMILY
00618           WRITE(LU,*) 'MED_ID=',ID_CHANGE_LOG(I,2),' <==> NCOLOR_ID=',
00619      &         ID_CHANGE_LOG(I,1)
00620         ENDDO
00621 
00622         ! READ MESH ENTITIES (AXIS, NODES)
00623         !-------------------------------------------------------
00624 
00625         ! READING THE NUMBER OF AXIS (HAVE BEEN ALREADY READEN IN MMHMII)
00626         CALL MMHNAX(FID,1,NDIM,CRET)
00627         CALL MED_CHECK_CRET(CRET,'MMHNAX')
00628 
00629         IF (NDIM.NE.MDIM) THEN ! E.G. = 3
00630           WRITE(LU,*) '3 DIMENSIONS MESH EXPECTED - FOUND ', NDIM
00631         END IF
00632 
00633         ! READING THE NUMBER OF NODES
00634         CALL MMHNME (FID, MESH_NAME, MED_NO_DT, MED_NO_IT, MED_NODE,
00635      &               MED_NONE, MED_COORDINATE, MED_NODAL, IDUM, IDUM,
00636      &               NPOINT, CRET)
00637         CALL MED_CHECK_CRET(CRET,'MMHNME')
00638 
00639         ! ALLOCATING BEFORE READING THE COORDINATES
00640         ALLOCATE(COOR(NPOINT*MDIM), STAT=IERR)
00641         CALL CHECK_ALLOCATE(IERR,' COOR')
00642 
00643         CALL MMHCOR(FID,TRIM(MESH_NAME),MED_NO_DT,MED_NO_IT,
00644      &       MED_NO_INTERLACE, COOR, CRET)
00645         CALL MED_CHECK_CRET(CRET,'MMHCOR')
00646 
00647         ALLOCATE(X1(NPOINT), STAT=IERR)
00648         CALL CHECK_ALLOCATE(IERR,' X1')
00649         ALLOCATE(Y1(NPOINT), STAT=IERR)
00650         CALL CHECK_ALLOCATE(IERR,' Y1')
00651         ALLOCATE(Z1(NPOINT), STAT=IERR)
00652         CALL CHECK_ALLOCATE(IERR,' Z1')
00653 
00654         DO I = 1, NPOINT
00655           X1(I) = COOR(I)
00656           Y1(I) = COOR(I+  NPOINT)
00657           Z1(I) = COOR(I+2*NPOINT)
00658         END DO
00659         DEALLOCATE(COOR)
00660 
00661         ! READ MESH ENTITIES (2D & 3D ELEMENTS)
00662         !---------------------------------------
00663 
00664         ! ATTENTION : DIFFERENT FROM UNV FORMAT
00665         ! GET TOTAL NUMBER OF TRIANGLES (TOTAL = INNER + BORDER MESH)
00666         CALL MMHNME(FID,MESH_NAME,MED_NO_DT,MED_NO_IT,MED_CELL,
00667      &             MED_TRIA3, MED_CONNECTIVITY,MED_NODAL,IDUM,IDUM,
00668      &             NBTRI2,CRET)
00669         CALL MED_CHECK_CRET(CRET,'MMHNME')
00670 
00671         ! GET NUMBER OF TETRA (3D MESH)
00672         CALL MMHNME(FID,MESH_NAME,MED_NO_DT,MED_NO_IT,MED_CELL,
00673      &             MED_TETRA4, MED_CONNECTIVITY,MED_NODAL,IDUM,IDUM,
00674      &             NBTET,CRET)
00675         CALL MED_CHECK_CRET(CRET,'MMHNME')
00676 
00677         ! ATTENTION : NBTRI = INNER + BORDER TRIANGLE
00678         ! PRINT A SUMMARY
00679         WRITE(LU,*)'NUMBER OF TETRAHEDRONS IN THE MESH',NBTET
00680         WRITE(LU,*)'NUMBER OF TRIANGLES IN THE MESH',   NBTRI2
00681         WRITE(LU,*)'NUMBER OF POINTS IN THE MESH',      NPOINT
00682         WRITE(LU,*)'NUMBER OF EXTERNAL FACES',          NBCOLOR
00683 
00684         TXT = ' '
00685         DO I=1, NBCOLOR
00686           DATA_TEMP = I2CHAR(PRIORITY(I))
00687           TXT_OLD = TXT
00688           TXT = TRIM(TXT_OLD) // ' ' // TRIM(DATA_TEMP)
00689         ENDDO
00690 
00691         WRITE(LU,*)'PRIORITE DES FACES EXTERNES'//TRIM(TXT)
00692 
00693         ALLOCATE(IKLESTET(NBTET*4), STAT=IERR)
00694         CALL CHECK_ALLOCATE(IERR,' IKLESTET')
00695         ALLOCATE(NUFATETRA(NBTET), STAT=IERR)
00696         CALL CHECK_ALLOCATE(IERR,' NUFATETRA')
00697         ALLOCATE(DUMNAME(NBTET),STAT=IERR)
00698         CALL CHECK_ALLOCATE(IERR,' DUMNAME')
00699         ALLOCATE(DUMNUM(NBTET),STAT=IERR)
00700         CALL CHECK_ALLOCATE(IERR,' DUMNUM')
00701 
00702         ! READ TETRA CONNECTIVITY AND TETRA FAMILIY
00703         CALL MMHELR(FID,MESH_NAME,MED_NO_DT,MED_NO_IT,MED_CELL,
00704      &             MED_TETRA4,MED_NODAL,MED_NO_INTERLACE,IKLESTET,IDUM,
00705      &             DUMNAME,IDUM,DUMNUM,IDUM,NUFATETRA,CRET)
00706         CALL MED_CHECK_CRET(CRET,'MMHELR')
00707         DEALLOCATE(DUMNAME,DUMNUM)
00708 
00709         ! YA_PARA_MODIF
00710         DO I=1,NBTET
00711           DO J=1,NBFAMILY
00712             IF (NUFATETRA(I).EQ.ID_CHANGE_LOG(J,2)) THEN
00713               NUFATETRA(I) = ID_CHANGE_LOG(J,1)
00714               EXIT
00715             ENDIF
00716           ENDDO
00717         ENDDO
00718         ! YA_PARA_MODIF FIN
00719 
00720         ! READ TRIANGLES CONNECTIVITY AND TRIANGLES FAMILIY
00721         ! S. FALAPPI : NBTRI2 MAY BE NULL IF WE TRY TO READ A MESH FILE
00722         ! WRITTEN BY ESTEL-3D WHERE NO BORDER CONNECTIVITY IS WRITTEN (DEBUG PURPOSES)
00723         IF (NBTRI2.GT.0) THEN
00724 
00725           ALLOCATE(IKLESTRI2(NBTRI2*3), STAT=IERR)
00726           CALL CHECK_ALLOCATE(IERR,' IKLESTRI2')
00727           ALLOCATE(NUFATRIA2(NBTRI2), STAT=IERR)
00728           CALL CHECK_ALLOCATE(IERR,' NUFATRIA2')
00729           ALLOCATE(DUMNAME(NBTRI2),STAT=IERR)
00730           CALL CHECK_ALLOCATE(IERR,' DUMNAME')
00731           ALLOCATE(DUMNUM(NBTRI2),STAT=IERR)
00732           CALL CHECK_ALLOCATE(IERR,' DUMNUM')
00733 
00734           CALL MMHELR(FID,MESH_NAME,MED_NO_DT,MED_NO_IT,MED_CELL,
00735      &         MED_TRIA3,MED_NODAL,MED_NO_INTERLACE,IKLESTRI2,IDUM,
00736      &         DUMNAME,IDUM,DUMNUM,IDUM,NUFATRIA2,CRET)
00737           CALL MED_CHECK_CRET(CRET,'MMHELR')
00738           DEALLOCATE(DUMNAME,DUMNUM)
00739 
00740           ALLOCATE(IKLESTRIN(NBTRI2,3), STAT=IERR)
00741           CALL CHECK_ALLOCATE(IERR,' IKLESTRIN')
00742 
00743           ! CORRECTION OF ORDER TO MATCH UNV FORMAT
00744           DO I = 1, NBTRI2
00745             IKLESTRIN(I,1) = IKLESTRI2(I)
00746             IKLESTRIN(I,2) = IKLESTRI2(I+NBTRI2)
00747             IKLESTRIN(I,3) = IKLESTRI2(I+2*NBTRI2)
00748           ENDDO
00749           DO I = 1, NBTRI2
00750             IKLESTRI2(3*(I-1)+1:3*I) = IKLESTRIN(I,1:3)
00751           ENDDO
00752           DEALLOCATE(IKLESTRIN)
00753 
00754           DO I=1,NBTRI2
00755             DO J=1,NBFAMILY
00756               IF (NUFATRIA2(I).EQ.ID_CHANGE_LOG(J,2)) THEN
00757                 NUFATRIA2(I) = ID_CHANGE_LOG(J,1)
00758                 EXIT
00759               ENDIF
00760             ENDDO
00761           ENDDO
00762         ENDIF
00763 
00764         !-----------------------------------------------------------------------
00765         ! BUILD NUFANO (BORDER MESH COLOR)
00766         ! On va reconstruire nufano a partir de la connectivite et des priorites.
00767         ! On part de la priorite la moins elevee (la derniere) jusqu'a la premiere
00768         ! Petit test pour savoir si on relit un maillage med de sortie de code ou
00769         ! un maillage med cree de toute piece.
00770         ! Dans le premier cas, on a aucune information sur les faces
00771         ! et par contre nufano est juste
00772         ALLOCATE(NUFANO(NPOINT), STAT=IERR)
00773         CALL CHECK_ALLOCATE(IERR,' NUFANO')
00774 
00775         IF (NBTRI2.GT.0) THEN
00776           NUFANO = 0
00777           DO I=NBCOLOR,1,-1
00778             DO J=1,NBTRI2
00779               IF (NUFATRIA2(J)==PRIORITY(I)) THEN
00780                 NUFANO(IKLESTRI2(3*(J-1)+1)) = PRIORITY(I)
00781                 NUFANO(IKLESTRI2(3*(J-1)+2)) = PRIORITY(I)
00782                 NUFANO(IKLESTRI2(3*J)) = PRIORITY(I)
00783               ENDIF
00784             ENDDO
00785           ENDDO
00786 
00787           SIZE_FLUXIN(:) = 0
00788           SIZE_FLUX = 0
00789           NELIN = 0
00790           NBTRI = 0
00791 
00792           DO J=1,NBTRI2
00793 
00794             IF (NUFATRIA2(J).GT.0) THEN
00795 
00796               ! NSOLS_OLD IS USED FOR SAVING USE OF A NEW VARIABLE
00797               NSOLS_OLD = NUFATRIA2(J)
00798 
00799               ! INNER SURFACE ARE SUPPOSED TO HAVE A NSOLS VALUE > 100
00800               IF (NSOLS_OLD.GT.MAXVAL(PRIORITY)) THEN
00801                 NSOLS_OLD = NSOLS_OLD - 100 + MAXVAL(PRIORITY)
00802               ENDIF
00803 
00804               PRIO_NEW = SIZE_FLUXIN(NSOLS_OLD)
00805               IF (PRIO_NEW.EQ.0) THEN
00806                 SIZE_FLUX = SIZE_FLUX + 1
00807                 SIZE_FLUXIN(NSOLS_OLD) = 1
00808               ENDIF
00809 
00810               IF (NUFATRIA2(J).LT.100) NBTRI = NBTRI + 1
00811 
00812               IF (NUFATRIA2(J).GE.100) NELIN = NELIN + 1
00813             ENDIF
00814           ENDDO
00815 
00816           ALLOCATE(IKLESTRIN(NELIN,4))
00817           CALL CHECK_ALLOCATE(IERR,' IKLESTRIN')
00818           IKLESTRIN(:,:)=-999
00819 
00820           I = 0
00821           DO J=1,NBTRI2
00822 
00823             IF (NUFATRIA2(J).GE.100) THEN
00824               I = I + 1
00825               IKLE1 = IKLESTRI2(3*(J-1)+1)
00826               IKLE2 = IKLESTRI2(3*(J-1)+2)
00827               IKLE3 = IKLESTRI2(3*J)
00828 
00829               IKLESTRIN(I,1) = NUFATRIA2(J)
00830               IKLESTRIN(I,2) = IKLE1
00831               IKLESTRIN(I,3) = IKLE2
00832               IKLESTRIN(I,4) = IKLE3
00833             ENDIF
00834           ENDDO
00835         ENDIF
00836 
00837         ! WRITE THE REAL NUMBER OF BORDER AND INNER TRIANGLES
00838         PRINT*,'CORRECTED NB OF BORDER TRIANGLES NBTRI',NBTRI
00839         PRINT*,'NUMBER OF INNER TRIANGLES NELIN',NELIN
00840 
00841         ! CORRECTION OF THE TOTAL NUMBER OF ELEMENT
00842         NELEMTOTAL = NBTET + NBTRI
00843         PRINT*,'CORRECTED TOTAL NUMBER OF ELEMENT',NELEMTOTAL
00844 
00845         ! ALLOCTAION OF IKLESTRI WHICH MATCH UNV FORMAT
00846         ALLOCATE(IKLESTRI(3*NBTRI))
00847         CALL CHECK_ALLOCATE(IERR,' IKLESTRI')
00848         ALLOCATE(NUFATRIA(NBTRI), STAT=IERR)
00849         CALL CHECK_ALLOCATE(IERR,' NUFATRIA')
00850 
00851         ! CORRECTION OF IKLESTRI TO REMOVE INNER TRIANGLES
00852         I = 0
00853         DO J=1,NBTRI2
00854           ! ONLY BORDER TRIANGLES
00855           IF ((NUFATRIA2(J).GT.0) .AND. (NUFATRIA2(J).LT.100)) THEN
00856             I = I + 1
00857             IKLESTRI(3*(I-1)+1) = IKLESTRI2(3*(J-1)+1)
00858             IKLESTRI(3*(I-1)+2) = IKLESTRI2(3*(J-1)+2)
00859             IKLESTRI(3*I)       = IKLESTRI2(3*J)
00860             NUFATRIA(I)         = NUFATRIA2(J)
00861           ENDIF
00862         ENDDO
00863         DEALLOCATE(IKLESTRI2)
00864         DEALLOCATE(NUFATRIA2)
00865 
00866         ALLOCATE(IKLE(NBTET,4), STAT=IERR)
00867         CALL CHECK_ALLOCATE(IERR,' IKLE')
00868         IKLE = 0
00869         DO I = 1, NBTET
00870           ! CORRECTION OF ORDER TO MATCH UNV FORMAT
00871           IKLE(I,1) = IKLESTET(I+NBTET)
00872           IKLE(I,2) = IKLESTET(I)
00873           IKLE(I,3) = IKLESTET(I+2*NBTET)
00874           IKLE(I,4) = IKLESTET(I+3*NBTET)
00875         ENDDO
00876 
00877         ALLOCATE(TYPELEM(NELEMTOTAL,2),STAT=IERR)
00878         CALL CHECK_ALLOCATE(IERR,' TYPELEM')
00879 
00880         ! RESCAN TO CHANGE ORDER IN IKLESTET
00881         ! AND FILE ELEMENT TABLE
00882         DO I = 1, NBTET
00883           IKLESTET(4*(I-1)+1:4*I) = IKLE(I,1:4)
00884           TYPELEM(I,1) = 111
00885           TYPELEM(I,2) = I
00886         ENDDO
00887 
00888         ALLOCATE(NBOR2(NPOINT), STAT=IERR)
00889         CALL CHECK_ALLOCATE(IERR,' NBOR2')
00890         ALLOCATE(GLOB_2_LOC(NPOINT))
00891         CALL CHECK_ALLOCATE(IERR,' GLOB_2_LOC')
00892         GLOB_2_LOC(:) = 0    ! GLOBAL TO LOCAL NUMBERING
00893         IPTFR = 0
00894 
00895         ! DEFINITION OF BOUNDARY NODE COLOR,
00896         ! GLOBAL TO LOCAL CONVERTER AND
00897         ! ELEMENT TABLE
00898         DO I = 1, NBTRI
00899           DO J = 1, 3
00900             IKL = IKLESTRI(3*(I-1)+J)
00901             K = GLOB_2_LOC(IKL)
00902             IF ((K.EQ.0).AND.(NUFANO(IKL)>0)) THEN
00903               IPTFR = IPTFR + 1
00904               NBOR2(IPTFR) = IKL
00905               GLOB_2_LOC(IKL) = IPTFR
00906             ENDIF
00907           ENDDO
00908         ENDDO
00909         NPTFR = IPTFR
00910         DEALLOCATE(GLOB_2_LOC)
00911 
00912         ALLOCATE(CONVTRI(NELEMTOTAL), STAT=IERR)
00913         CALL CHECK_ALLOCATE(IERR,' CONVTRI')
00914         ! DEFINITION OF TYPE FOR TRIANGLE
00915         DO I = 1,NBTRI
00916           IDUM = NBTET + I
00917           CONVTRI(I) = IDUM
00918           TYPELEM(IDUM,1) = 91
00919           TYPELEM(IDUM,2) = I
00920         ENDDO
00921 
00922         ALLOCATE(ECOLOR(NELEMTOTAL), STAT=IERR)
00923         CALL CHECK_ALLOCATE(IERR,' ECOLOR')
00924 
00925         ! DEFINITION OF ELEMENT COLOR (TETRA AND TRIANGLE)
00926         ECOLOR = 0
00927         DO I = 1, NBTET
00928           ECOLOR(I) = NUFATETRA(I)
00929         END DO
00930         DEALLOCATE(NUFATETRA)
00931         DO I = 1, NBTRI
00932           ECOLOR(I+NBTET) = NUFATRIA(I)
00933         END DO
00934         DEALLOCATE(NUFATRIA)
00935 
00936         ALLOCATE(NCOLOR2(NPOINT), STAT=IERR)
00937         CALL CHECK_ALLOCATE(IERR,' NCOLOR2')
00938 
00939         NCOLOR2(:) = 0
00940         DO I = 1, NPTFR
00941           NCOLOR2(NBOR2(I)) = NUFANO(NBOR2(I))
00942         END DO
00943         DEALLOCATE(NUFANO)
00944 
00945         ! ALLOCATION REQUIRED FOR THE FUTUR
00946         ALLOCATE(NPOINTSD(NPARTS),STAT=IERR)
00947         CALL CHECK_ALLOCATE(IERR,' NPOINTSD')
00948         ALLOCATE(NELEMSD(NPARTS),STAT=IERR)
00949         CALL CHECK_ALLOCATE(IERR,' NELEMSD')
00950         ALLOCATE(NPOINTISD(NPARTS),STAT=IERR)
00951         CALL CHECK_ALLOCATE(IERR,' NPOINTISD')
00952       ENDIF
00953 
00954 #endif
00955 
00956 !     READ THE MESH FILE (UNV)
00957       IF (.NOT.FORMAT_MED) THEN
00958 
00959         ! ALLOCATIONS
00960         ALLOCATE(X1(NPOINT),STAT=IERR)
00961         CALL CHECK_ALLOCATE(IERR,' X1')
00962         ALLOCATE(Y1(NPOINT),STAT=IERR)
00963         CALL CHECK_ALLOCATE(IERR,' Y1')
00964         ALLOCATE(Z1(NPOINT),STAT=IERR)
00965         CALL CHECK_ALLOCATE(IERR,' Z1')
00966         ALLOCATE(NCOLOR(NPOINT),STAT=IERR)
00967         CALL CHECK_ALLOCATE(IERR,' NCOLOR')
00968         ALLOCATE(NCOLOR2(NPOINT),STAT=IERR)
00969         CALL CHECK_ALLOCATE(IERR,' NCOLOR2')
00970         ALLOCATE(ECOLOR(NELEMTOTAL),STAT=IERR)
00971         CALL CHECK_ALLOCATE(IERR,' ECOLOR')
00972         ALLOCATE(IKLESTET(4*NELEMTOTAL),STAT=IERR)
00973         CALL CHECK_ALLOCATE(IERR,' IKLESTET')
00974         ALLOCATE(IKLESTRI(3*NELEMTOTAL),STAT=IERR)
00975         CALL CHECK_ALLOCATE(IERR,' IKLESTRI')
00976         ALLOCATE(IKLESTRIN(NELEMTOTAL,4),STAT=IERR)
00977         CALL CHECK_ALLOCATE(IERR,' IKLESTRIN')
00978         ALLOCATE(TYPELEM(NELEMTOTAL,2),STAT=IERR)
00979         CALL CHECK_ALLOCATE(IERR,' TYPELEM')
00980         ALLOCATE(CONVTRI(NELEMTOTAL),STAT=IERR)
00981         CALL CHECK_ALLOCATE(IERR,' CONVTRI')
00982         ALLOCATE(NPOINTSD(NPARTS),STAT=IERR)
00983         CALL CHECK_ALLOCATE(IERR,' NPOINTSD')
00984         ALLOCATE(NELEMSD(NPARTS),STAT=IERR)
00985         CALL CHECK_ALLOCATE(IERR,' NELEMSD')
00986         ALLOCATE(NPOINTISD(NPARTS),STAT=IERR)
00987         CALL CHECK_ALLOCATE(IERR,' NPOINTISD')
00988 
00989 !F.D
00990         ALLOCATE(NBOR2(NPOINT),STAT=IERR)
00991         CALL CHECK_ALLOCATE(IERR,' NBOR2')
00992         ALLOCATE(TEMPO(2*NPOINT),STAT=IERR)
00993         CALL CHECK_ALLOCATE(IERR,' TEMPO')
00994         ALLOCATE(FACE_CHECK(NBFAMILY),STAT=IERR)
00995         CALL CHECK_ALLOCATE(IERR,' FACE_CHECK')
00996         ALLOCATE(GLOB_2_LOC(NPOINT),STAT=IERR)
00997         CALL CHECK_ALLOCATE(IERR,' GLOB_2_LOC')
00998         ALLOCATE(IKLES(NELEMTOTAL,4),STAT=IERR)
00999 
01000         READ_SEC1 = .TRUE.
01001         READ_SEC2 = .TRUE.
01002         READ_SEC3 = .TRUE.
01003 
01004         DO WHILE ( READ_SEC1 .OR. READ_SEC2 .OR. READ_SEC3 )
01005 
01006           MOINS1 = '  '
01007           BLANC  = '1111'
01008           DO WHILE (MOINS1/='-1' .OR. BLANC/='    ')
01009             READ(NINP,2000, ERR=1100, END=1200) BLANC, MOINS1
01010           END DO
01011 
01012  2000     FORMAT(A4,A2)
01013 
01014           NSEC = -1
01015 
01016           DO WHILE (NSEC == -1)
01017             READ(NINP,*, ERR=1100, END=1200) NSEC
01018           END DO
01019 
01020           SELECT CASE (NSEC)
01021 
01022           CASE ( NSEC1 )
01023 
01024             READ_SEC1 = .FALSE.
01025 
01026             READ(NINP,25,ERR=1100, END=1200) TITRE
01027 
01028  25         FORMAT(A80)
01029 
01030           CASE ( NSEC2 )
01031 
01032             READ_SEC2 = .FALSE.
01033             NCOLOR(:) = -1
01034             TEMPO(:)  =  0
01035 
01036             DO IELEM = 1, NPOINT
01037               READ(NINP,*,ERR=1100,END=1200) N,N1,N2,NCOLOR(IELEM)
01038               READ(NINP,*,ERR=1100,END=1200) X1(IELEM), Y1(IELEM),
01039      &            Z1(IELEM)
01040               TEMPO(N) = IELEM
01041             ENDDO
01042 
01043           CASE (NSEC3 )
01044 
01045             READ_SEC3 = .FALSE.
01046 
01047             NBTET         = 0  ! NUMBER OF TETRA ELEMENTS TO 0
01048             NBTRI         = 0  ! NUMBER OF BORDER ELEMENTS TO 0
01049             NPTFR         = 0  ! NUMBER OF BORDER NODES TO 0.
01050             NELIN         = 0  ! NUMBER OF INNER SURFACES TO 0.
01051             SIZE_FLUX     = 0  ! NUMBER OF USER SURFACES TO 0.
01052             NBOR2(:)      = 0  ! LOCAL TO GLOBAL NUMBERING
01053             GLOB_2_LOC(:) = 0  ! GLOBAL TO LOCAL NUMBERING
01054 
01055 !OB'S STFF
01056             ECOLOR(:)    = -1
01057             IKLESTET(:)  = -1
01058             IKLESTRI(:)  = -1
01059             TYPELEM(:,:) = -1
01060             CONVTRI(:)   = -1
01061 !
01062             IKLESTRIN(:,:) = -1
01063 
01064             FACE_CHECK(:) = .FALSE.
01065             !
01066             COLOR_PRIO(:)  = 0
01067             SIZE_FLUXIN(:) = 0
01068             !
01069             DO K = 1, NBCOLOR
01070               COLOR_PRIO(PRIORITY(K)) = K
01071             END DO
01072 
01073             DO IELEM = 1, NELEMTOTAL
01074 
01075               READ(NINP,*,ERR=1100,END=1200) NSEC, ELEM, N1, N2,
01076      &            NSOLS,N3
01077 
01078               IF (NSEC == -1) EXIT
01079 
01080               SELECT CASE ( ELEM )
01081 
01082               CASE ( 111 )
01083 
01084                 NBTET        = NBTET + 1
01085 
01086                 ECOLOR(IELEM) = NSOLS
01087 
01088                 READ(NINP,*, ERR=1100, END=1200) IKLE1, IKLE2,
01089      &              IKLE3,IKLE4
01090 
01091                 IKLES(IELEM, 1) = TEMPO(IKLE1)
01092                 IKLES(IELEM, 2) = TEMPO(IKLE2)
01093                 IKLES(IELEM, 3) = TEMPO(IKLE3)
01094                 IKLES(IELEM, 4) = TEMPO(IKLE4)
01095 
01096 !OB'S STFF
01097                 N=4*(NBTET-1)+1
01098                 IKLESTET(N)=IKLE1    ! VECTEUR DE CONNECTIVITE
01099                 IKLESTET(N+1)=IKLE2
01100                 IKLESTET(N+2)=IKLE3
01101                 IKLESTET(N+3)=IKLE4
01102                 TYPELEM(IELEM,1)=ELEM    ! POUR TYPER LES ELTS
01103                 TYPELEM(IELEM,2)=NBTET   ! POUR CONVERSION NUM ELT> NUM TETRA
01104 
01105               CASE ( 91 )
01106 
01107                 IF (NSOLS.GT.0.AND.NSOLS.LT.100) THEN
01108 
01109                   IF ( NSOLS > NCOL ) THEN
01110                     WRITE(LU,*) 'COLOR ID POUR SURFACES EXTERNE'
01111      &              // 'S TROP GRAND. LA LIMITE EST : ',NCOL
01112                   END IF
01113 
01114                   PRIO_NEW = COLOR_PRIO(NSOLS)
01115 
01116                   IF ( PRIO_NEW .EQ. 0 ) THEN
01117                     WRITE(LU,*) ' NUMERO DE FACE NON DECLARE',
01118      &                 'DANS LE TABLEAU UTILISATEUR LOGFAMILY ',
01119      &                 'VOIR LE FICHIER DES PARAMETRES '
01120                     CALL PLANTE(1)
01121                   END IF
01122 
01123                   FACE_CHECK(PRIO_NEW) = .TRUE.
01124 
01125                   NBTRI = NBTRI + 1
01126 
01127                   ECOLOR(IELEM) = NSOLS
01128 
01129                   READ(NINP,*,ERR=1100,END=1200)IKLE1,IKLE2,IKLE3
01130                   !
01131                   PRIO_NEW = SIZE_FLUXIN(NSOLS)
01132                   !
01133                   IF (PRIO_NEW.EQ.0) THEN
01134                     SIZE_FLUX = SIZE_FLUX + 1
01135                     SIZE_FLUXIN(NSOLS) = 1
01136                   ENDIF
01137 
01138                   IKLES(IELEM, 1) = TEMPO(IKLE1)
01139                   IKLES(IELEM, 2) = TEMPO(IKLE2)
01140                   IKLES(IELEM, 3) = TEMPO(IKLE3)
01141 
01142 !OB'S STFF
01143                   N=3*(NBTRI-1)+1
01144                   IKLESTRI(N)=IKLE1
01145                   IKLESTRI(N+1)=IKLE2
01146                   IKLESTRI(N+2)=IKLE3
01147                   TYPELEM(IELEM,1)=ELEM    ! IDEM QUE POUR TETRA
01148                   TYPELEM(IELEM,2)=NBTRI
01149                   CONVTRI(NBTRI)=IELEM
01150 
01151                   DO J=1,3
01152 
01153                     IKL = IKLES(IELEM,J)
01154 
01155                     IPTFR = GLOB_2_LOC(IKL)
01156 
01157                     IF ( IPTFR .EQ. 0 ) THEN
01158 
01159                       NPTFR           = NPTFR+1
01160                       NBOR2(NPTFR)    = IKL
01161                       GLOB_2_LOC(IKL) = NPTFR
01162                       IPTFR           = NPTFR
01163 
01164                     END IF
01165 
01166                   ENDDO  ! LOOP OVER THE NODES OF THE ELEMENT
01167 
01168                 ELSE IF (NSOLS.GT.100) THEN
01169                   !
01170                   ! USER-DEFINED SURFACE FOR FLUXES COMPUTATION
01171                   !
01172                   ! NELIN IS THE COUNTER FOR THE INTERNAL ELEMENTS.
01173                   ! ACTUALLY, WE ARE READING THE NEXT INTERNAL ELEMENT.
01174 
01175                   ! NSOLS_OLD IS USED FOR SAVING USE OF A NEW VARIABLE
01176                   NSOLS_OLD = NSOLS
01177                   !
01178                   ! PRIO_NEW IS USED FOR SAVING USE OF A NEW VARIABLE
01179                   PRIO_NEW = SIZE_FLUXIN(NSOLS_OLD)
01180                   !
01181                   IF (PRIO_NEW.EQ.0) THEN
01182                     SIZE_FLUX = SIZE_FLUX + 1
01183                     SIZE_FLUXIN(NSOLS_OLD) = 1
01184                   ENDIF
01185                   !
01186                   NELIN = NELIN + 1
01187                   !
01188                   READ(NINP,*,ERR=1100,END=1200)IKLE1,IKLE2,IKLE3
01189                   !
01190                   IKLESTRIN(NELIN,1) = NSOLS
01191                   IKLESTRIN(NELIN,2) = TEMPO(IKLE1)
01192                   IKLESTRIN(NELIN,3) = TEMPO(IKLE2)
01193                   IKLESTRIN(NELIN,4) = TEMPO(IKLE3)
01194                   !
01195                 ELSE        ! THIS IS AN INNER SURFACE, JUST READ THE LINE.
01196 
01197                   READ(NINP,*,ERR=1100,END=1200)IKLE1,IKLE2,IKLE3
01198 
01199                 END IF
01200 
01201               CASE DEFAULT      ! THIS IS AN UNKNOWN ELEMENT.
01202 
01203                 WRITE(LU,*) 'ELEMENT INCONNU DANS LE MAILLAGE'
01204 
01205               END SELECT        ! THE TYPE OF THE MESH ELEMENT
01206 
01207             END DO               ! LOOP OVER ELEMENTS TO READ.
01208 
01209             DO K=1,NBCOLOR
01210               IF (.NOT. FACE_CHECK(K)) THEN
01211                 WRITE(LU,*) ' LA COULEUR DE FACE ',K,
01212      &          ' N''APPARAIT PAS DANS LE MAILLAGE.'
01213               END IF
01214             END DO
01215 
01216 !-----------------------------------------------------------------------
01217 
01218           END SELECT                ! TYPE OF THE SECTION
01219 
01220         END DO                    ! WHILE LOOP OVER SECTIONS TO READ
01221 
01222 !------------------------------------------------------- FIN VERSION F.D
01223 
01224       ENDIF
01225 
01226       ! CORRECTION DU NOMBRE D'ELEMENTS TOTAL CAR CELUI DANS LE .LOG EST
01227       ! COMPORTE DES ELEMENTS NON PRIS EN COMPTE DANS UNE ETUDE ESTEL
01228       NELEMTOTAL=NBTET+NBTRI
01229 
01230 ! FIN MODIF V STOBIAC
01231 
01232       CALL SYSTEM_CLOCK(COUNT=TEMPS_SC(2),COUNT_RATE=PARSEC)
01233       WRITE(LU,*)' TEMPS DE LECTURE FICHIERS LOG & UNV',
01234      &           (1.0*(TEMPS_SC(2)-TEMPS_SC(1)))/(1.0*PARSEC),' SECONDS'
01235 
01236 !----------------------------------------------------------------------
01237 ! 3A. CONSTRUCTION DE TETTRI/TETTRI2: CORRESPONDANCE TETRA > TRIA
01238 !---------------
01239 
01240       ALLOCATE(NELBOR(NBTRI),STAT=IERR)
01241       CALL CHECK_ALLOCATE(IERR,' NELBOR')
01242       ALLOCATE(IKLBOR(NBTRI,3),STAT=IERR)
01243       CALL CHECK_ALLOCATE(IERR,' IKLBOR')
01244       ALLOCATE(IFABOR(NBTET,4),STAT=IERR)
01245       CALL CHECK_ALLOCATE(IERR,' IFABOR')
01246 
01247 !     BEGIN MODIF VSTOBIAC
01248       IF (.NOT. FORMAT_MED) THEN
01249 
01250         ALLOCATE(IKLE(NBTET,4),STAT=IERR)
01251         CALL CHECK_ALLOCATE(IERR,' IKLE')
01252 
01253         DO IELEM = 1, NBTET
01254           DO I = 1,4
01255             IKLE(IELEM,I ) = IKLES (IELEM, I)
01256           END DO
01257         END DO
01258 
01259         DEALLOCATE(IKLES)
01260 
01261       ENDIF
01262 !
01263       IF (NELIN .GT. 0) THEN
01264         ALLOCATE(IKLEIN(NELIN,4),STAT=IERR)
01265         CALL CHECK_ALLOCATE(IERR,' IKLEIN')
01266 !
01267         DO IELEM = 1, NELIN
01268           DO I = 1,4
01269             IKLEIN(IELEM,I ) = IKLESTRIN (IELEM, I)
01270           END DO
01271         END DO
01272       ELSE
01273         ALLOCATE(IKLEIN(1,4),STAT=IERR)
01274       ENDIF
01275       DEALLOCATE(IKLESTRIN)
01276 !
01277       WRITE(LU,*) 'FIN DE LA COPIE DE LA CONNECTIVITE INITIALE'
01278 !
01279       ALLOCATE(NBOR(NPTFR),STAT=IERR)
01280       CALL CHECK_ALLOCATE(IERR,' NBOR')
01281 !
01282       DO IELEM = 1, NPTFR
01283         NBOR(IELEM) = NBOR2(IELEM)
01284       ENDDO
01285 !
01286       DEALLOCATE(NBOR2)
01287 !
01288       WRITE(LU,*) 'PARTEL_VOISIN31'
01289 !
01290       CALL VOISIN31(IFABOR,NBTET,NBTET,31,
01291      &              IKLE,NBTET,NPOINT,NBOR,NPTFR,
01292      &              LIHBOR,2,INDPU,IKLESTRI,NBTRI)
01293 !
01294       WRITE(LU,*) 'FIN DE PARTEL_VOISIN31'
01295 !
01296       ALLOCATE(LIHBOR(NPTFR),STAT=IERR)
01297       CALL CHECK_ALLOCATE(IERR,'LIHBOR')
01298       ALLOCATE(NULONE(NBTRI,3),STAT=IERR)
01299       CALL CHECK_ALLOCATE(IERR,' NULONE')
01300 !
01301       CALL ELEBD31( NELBOR, NULONE, IKLBOR,
01302      &              IFABOR, NBOR, IKLE,
01303      &              NBTET, NBTRI, NBTET, NPOINT,
01304      &              NPTFR,31)
01305 !
01306       DEALLOCATE(LIHBOR)
01307       DEALLOCATE(NULONE)
01308 !
01309       WRITE(LU,*) 'FIN DE PARTEL_ELEBD31'
01310       ALLOCATE(NUMBER_TRIA(NPOINT),STAT=IERR)
01311       CALL CHECK_ALLOCATE(IERR,'NUMBER_TRIA')
01312       NUMBER_TRIA = 0
01313 !
01314       MAX_TRIA=0
01315       DO J = 1, NBTRI
01316         K = 3*(J-1)+1
01317         IKLE1 = IKLESTRI(K)
01318         IKLE2 = IKLESTRI(K+1)
01319         IKLE3 = IKLESTRI(K+2)
01320         THE_TRI=IKLE1
01321         IF (IKLE2 < THE_TRI) THE_TRI=IKLE2
01322         IF (IKLE3< THE_TRI)  THE_TRI=IKLE3
01323         NUMBER_TRIA(THE_TRI)=NUMBER_TRIA(THE_TRI)+1
01324       END DO
01325       MAX_TRIA=MAXVAL(NUMBER_TRIA)
01326 !
01327       DEALLOCATE(NUMBER_TRIA)
01328 !
01329       ALLOCATE(TRI_REF(NPOINT,0:MAX_TRIA),STAT=IERR)
01330       CALL CHECK_ALLOCATE(IERR,' TRI_REF')
01331       TRI_REF=0
01332       DO J = 1, NBTRI
01333         K = 3*(J-1)+1
01334         IKLE1 = IKLESTRI(K)
01335         IKLE2 = IKLESTRI(K+1)
01336         IKLE3 = IKLESTRI(K+2)
01337         THE_TRI=IKLE1
01338         IF (IKLE2 < THE_TRI) THE_TRI=IKLE2
01339         IF (IKLE3< THE_TRI)  THE_TRI=IKLE3
01340         TRI_REF(THE_TRI,0)=TRI_REF(THE_TRI,0)+1
01341         POS=TRI_REF(THE_TRI,0)
01342         TRI_REF(THE_TRI,POS)=J
01343       END DO
01344 
01345       ALLOCATE(TETTRI(4*NBTET),STAT=IERR)
01346       CALL CHECK_ALLOCATE(IERR,' TETTRI')
01347       ALLOCATE(TETTRI2(NBTET),STAT=IERR)
01348       CALL CHECK_ALLOCATE(IERR,' TETTRI2')
01349       TETTRI (:) =-1
01350       TETTRI2(:) =0
01351 
01352       DO IELEB = 1,NBTRI
01353         IELEM = NELBOR(IELEB)
01354         IKLE1 = NBOR(IKLBOR(IELEB,1))
01355         IKLE2 = NBOR(IKLBOR(IELEB,2))
01356         IKLE3 = NBOR(IKLBOR(IELEB,3))
01357         THE_TRI=IKLE1
01358         IF (IKLE2 < THE_TRI) THE_TRI=IKLE2
01359         IF (IKLE3<THE_TRI)  THE_TRI=IKLE3
01360         POS=TRI_REF(THE_TRI,0)
01361         IS = .FALSE.
01362         M  = -1
01363         DO JJ = 1, POS
01364           J=TRI_REF(THE_TRI,JJ)
01365           K = 3*(J-1)+1
01366           IF ((IKLE1.EQ.IKLESTRI(K)).AND.
01367      &        (IKLE2.EQ.IKLESTRI(K+1)).AND.
01368      &        (IKLE3.EQ.IKLESTRI(K+2))) THEN
01369             IS = .TRUE.
01370           ELSE IF ((IKLE1.EQ.IKLESTRI(K)).AND.
01371      &        (IKLE3.EQ.IKLESTRI(K+1)).AND.
01372      &        (IKLE2.EQ.IKLESTRI(K+2))) THEN
01373             IS = .TRUE.
01374           ELSE IF ((IKLE2.EQ.IKLESTRI(K)).AND.
01375      &        (IKLE1.EQ.IKLESTRI(K+1)).AND.
01376      &            (IKLE3.EQ.IKLESTRI(K+2))) THEN
01377             IS = .TRUE.
01378           ELSE IF ((IKLE2.EQ.IKLESTRI(K)).AND.
01379      &        (IKLE3.EQ.IKLESTRI(K+1)).AND.
01380      &        (IKLE1.EQ.IKLESTRI(K+2))) THEN
01381             IS = .TRUE.
01382           ELSE IF ((IKLE3.EQ.IKLESTRI(K)).AND.
01383      &        (IKLE1.EQ.IKLESTRI(K+1)).AND.
01384      &        (IKLE2.EQ.IKLESTRI(K+2))) THEN
01385             IS = .TRUE.
01386           ELSE IF ((IKLE3.EQ.IKLESTRI(K)).AND.
01387      &        (IKLE2.EQ.IKLESTRI(K+1)).AND.
01388      &        (IKLE1.EQ.IKLESTRI(K+2))) THEN
01389             IS = .TRUE.
01390           ENDIF
01391           IF (IS) THEN
01392             M = J
01393             EXIT
01394           ENDIF
01395         ENDDO
01396         DO I = 1,4
01397           IF (IFABOR(IELEM,I).LE.0) THEN
01398             IF ((IKLE1.EQ.(IKLE(NELBOR(IELEB),SOMFAC(1,I))))
01399      &      .AND.(IKLE2.EQ.(IKLE(NELBOR(IELEB),SOMFAC(2,I))))
01400      &      .AND. (IKLE3.EQ.(IKLE(NELBOR(IELEB),SOMFAC(3,I)))))
01401      &      THEN
01402               NI = TETTRI2(IELEM)
01403               N  = 4*(IELEM-1)+NI+1
01404               TETTRI(N) = M
01405 !             WRITE(*,*) N, '---> ',M
01406               TETTRI2(IELEM) = NI + 1
01407             ENDIF
01408           ENDIF
01409         END DO
01410       ENDDO
01411 !
01412       DEALLOCATE(IFABOR)
01413       DEALLOCATE(IKLBOR)
01414       DEALLOCATE(NELBOR)
01415       DEALLOCATE(TRI_REF)
01416       DEALLOCATE(IKLE)
01417 !
01418       CALL SYSTEM_CLOCK(COUNT=TEMPS_SC(3),COUNT_RATE=PARSEC)
01419 !------------------------------------------------------- FIN VERSION F.D
01420 
01421 ! 3B. CONSTRUCTION DE NODES1/NODES2/NODES3: CONNECTIVITE INVERSE NOEUD > TETRA
01422 !     POUR L'ECRITURE A LA VOLEE DES UNV LOCAUX
01423 !---------------
01424 ! PARCOURS DES MAILLES POUR CONNAITRE LE NOMBRE DE MAILLES QUI
01425 ! LES REFERENCE
01426       ALLOCATE(NODES1(NPOINT),STAT=IERR)
01427       CALL CHECK_ALLOCATE(IERR,' NODES1')
01428       NODES1(:)=0
01429       DO I=1,NBTET
01430         DO K=1,4
01431           IKLEB=IKLESTET(4*(I-1)+K)
01432           NODES1(IKLEB)=NODES1(IKLEB)+1
01433         ENDDO
01434       ENDDO
01435 ! NOMBRE DE REFERENCEMENT DE POINTS ET POINTEUR NODES2 VERS NODES3
01436 ! LE IEME POINT A SA LISTE DE TETRA (EN NUMEROTATION LOCALE TETRA)
01437 ! DE NODES3(NODES2(I)) A NODES3(NODES2(I)+NODES1(I)-1)
01438       ALLOCATE(NODES2(NPOINT+1),STAT=IERR)
01439       CALL CHECK_ALLOCATE(IERR,' NODES2')
01440       COMPT=0
01441       NODES2(1)=1
01442       DO I=1,NPOINT
01443         COMPT=COMPT+NODES1(I)
01444         NODES2(I+1)=COMPT+1
01445       ENDDO
01446 ! POUR UN NOEUDS DONNE, QU'ELLES SONT LES MAILLES QUI LE CONCERNENT
01447       ALLOCATE(NODES3(COMPT),STAT=IERR)
01448       CALL CHECK_ALLOCATE(IERR,' NODES3')
01449       NODES3(:)=-1
01450       DO I=1,NBTET
01451         DO K=1,4
01452           IKLEB=IKLESTET(4*(I-1)+K)
01453           NI=NODES2(IKLEB)
01454           NF=NI+NODES1(IKLEB)-1
01455           NT=-999
01456           DO N=NI,NF ! ON CHERCHE LE PREMIER INDICE DE LIBRE DE NODES3
01457             IF (NODES3(N)==-1) THEN
01458               NT=N
01459               EXIT
01460             ENDIF
01461           ENDDO ! EN N
01462           IF (NT==-999) THEN
01463             GOTO 146  ! PB DE DIMENSIONNEMENT DE VECTEURS NODESI
01464           ELSE
01465             NODES3(NT)=I  ! NUMERO LOCAL DU TETRA I ASSOCIE AU NOEUD NT
01466           ENDIF
01467         ENDDO
01468       ENDDO
01469 
01470 ! 3C. CONSTRUCTION DE NODES1T/NODES2T/NODES3T: CONNECTIVITE INVERSE NOEUD > TRIA
01471 !     POUR LA COULEUR DES NOEUDS (DIRICHLET SUR L'INTERFACE)
01472 !---------------
01473       ALLOCATE(NODES1T(NPOINT),STAT=IERR)
01474       CALL CHECK_ALLOCATE(IERR,' NODES1T')
01475       NODES1T(:)=0
01476       DO I=1,NBTRI
01477         DO K=1,3
01478           IKLEB=IKLESTRI(3*(I-1)+K)
01479           NODES1T(IKLEB)=NODES1T(IKLEB)+1
01480         ENDDO
01481       ENDDO
01482 
01483       ALLOCATE(NODES2T(NPOINT+1),STAT=IERR)
01484       CALL CHECK_ALLOCATE(IERR,' NODES2T')
01485       COMPT=0
01486       NODES2T(1)=1
01487       DO I=1,NPOINT
01488         COMPT=COMPT+NODES1T(I)
01489         NODES2T(I+1)=COMPT+1
01490       ENDDO
01491       ALLOCATE(NODES3T(COMPT),STAT=IERR)
01492       CALL CHECK_ALLOCATE(IERR,' NODES3T')
01493       NODES3T(:)=-1
01494       DO I=1,NBTRI
01495         DO K=1,3
01496           IKLEB=IKLESTRI(3*(I-1)+K)
01497           NI=NODES2T(IKLEB)
01498           NF=NI+NODES1T(IKLEB)-1
01499           NT=-999
01500           DO N=NI,NF ! ON CHERCHE LE PREMIER INDICE DE LIBRE DE NODES3T
01501             IF (NODES3T(N)==-1) THEN
01502               NT=N
01503               EXIT
01504             ENDIF
01505           ENDDO ! EN N
01506           IF (NT==-999) THEN
01507             GOTO 146  ! PB DE DIMENSIONNEMENT DE VECTEURS NODESI
01508           ELSE
01509             NODES3T(NT)=I  ! NUMERO LOCAL DU TETRA I ASSOCIE AU NOEUD NT
01510           ENDIF
01511         ENDDO
01512       ENDDO
01513       CALL SYSTEM_CLOCK(COUNT=TEMPS_SC(4),COUNT_RATE=PARSEC)
01514       WRITE(LU,*)' TEMPS CONNECTIVITE INVERSE PART1/ PART2',
01515      &          (1.0*(TEMPS_SC(3)-TEMPS_SC(2)))/(1.0*PARSEC),'/',
01516      &          (1.0*(TEMPS_SC(4)-TEMPS_SC(3)))/(1.0*PARSEC),' SECONDS'
01517 
01518 !----------------------------------------------------------------------
01519 ! 4. PARTITIONING
01520 !---------------
01521 
01522 !        DO I=1,4*NBTET
01523 !                WRITE(LU,*) 'TETTRIALPHA',TETTRI(I)
01524 !        ENDDO
01525 !        DO I=1,NBTET
01526 !                WRITE(LU,*) 'TETTRIBETA',TETTRI2(I)
01527 !        ENDDO
01528 !
01529 !----------------------------------------------------------------------
01530 !     NEW METIS INTERFACE (>= VERSION 5) :
01531 !
01532       ALLOCATE(EPART(NBTET),STAT=IERR)
01533       CALL CHECK_ALLOCATE (IERR, 'EPART')
01534       ALLOCATE (NPART(NPOINT),STAT=IERR)
01535       CALL CHECK_ALLOCATE (IERR, 'NPART')
01536 !
01537 !----------------------------------------------------------------------
01538 !    CALL METIS : MESH PARTITIONNING
01539 !
01540       CALL SYSTEM_CLOCK(COUNT=TEMPS_SC(5),COUNT_RATE=PARSEC)
01541 !
01542       WRITE(LU,*)' '
01543       WRITE(LU,*)' STARTING METIS MESH PARTITIONING------------------+'
01544 !
01545       CALL PARTITIONER(PMETHOD, NBTET, NPOINT, 4, NPARTS, IKLESTET,
01546      &                 EPART, NPART)
01547 !
01548       CALL SYSTEM_CLOCK(COUNT=TEMPS_SC(6),COUNT_RATE=PARSEC)
01549 !
01550       WRITE(LU,*)' '
01551       WRITE(LU,*)' END METIS MESH PARTITIONING------------------+'
01552       WRITE(LU,*)' TEMPS CONSOMME PAR  METIS ',
01553      &           (1.0*(TEMPS_SC(6)-TEMPS_SC(5)))/(1.0*PARSEC),' SECONDS'
01554       WRITE(LU,80) NELEMTOTAL,NPOINT
01555       WRITE(LU,81) NBTET,NBTRI
01556       WRITE(LU,82) NPARTS
01557       WRITE(LU,*) 'SORTIE DE METIS CORRECTE'
01558 !
01559 !
01560 !D ******************************************************
01561 !D     LOOP OVER THE TETRA TO COMPUTER THE NUMBER AND THE LABEL
01562 !D     OF FINITE ELEMENTS ASSIGNED TO  EACH SUBDOMAIN
01563 !D ******************************************************
01564 !D     COMPUTATION OF THE MAXIMUM NUMBER OF FINITE ELEMENTS ASSIGNED TO ONE SUBDOMAIN
01565       NELEM_P(:)=0
01566       NPOIN_P(:)=0
01567       DO I=1,NBTET
01568         NELEM_P(EPART(I))=NELEM_P(EPART(I))+1
01569       END DO
01570       MAX_NELEM_P=MAXVAL(NELEM_P)
01571       WRITE(LU,*) 'NB MAX OF TETRAS PER SUBDOMAIN : ',MAX_NELEM_P
01572       WRITE(LU,*) 'NB OF TETRA PER SUBDOMAIN :'
01573       DO I=1,NPARTS
01574         WRITE(LU,*) I, NELEM_P(I)
01575       ENDDO
01576       NELEM_P(:)=0
01577 !D     ALLOCATION OF THE ELEGL ARRAY
01578       ALLOCATE(ELEGL(MAX_NELEM_P,NPARTS),STAT=IERR)
01579 !D     ELEGL IS THE FILLED
01580       CALL CHECK_ALLOCATE(IERR,'ELEGL')
01581       DO I=1,NBTET
01582         NELEM_P(EPART(I))=NELEM_P(EPART(I))+1
01583         ELEGL(NELEM_P(EPART(I)),EPART(I))=I
01584       END DO
01585 !D    COMPUTE THE MAXIMUM OF NODES ASSIGNED TO ONE SUBDOMAIN
01586 
01587       ALLOCATE(NODELG(NPOINT,NPARTS),STAT=IERR)
01588       CALL CHECK_ALLOCATE(IERR,'NODELG')
01589 
01590       NODELG(:,:)=0
01591 !D    FOR EACH SUBDOMAIN IDD
01592       DO IDD=1,NPARTS
01593 !D      LOOP ON THE FINITE ELEMENTS IELEM ASSIGNED TO SUBDOMAIN IDD
01594         DO POS=1,NELEM_P(IDD)
01595           IELEM=ELEGL(POS,IDD)
01596           N=4*(IELEM-1)+1
01597 !D        LOOP OF THE NODE CONTAINED IN IELEM
01598           DO K=0,3
01599             NODE=IKLESTET(N+K)
01600             IF (NODELG(NODE,IDD) .EQ. 0) THEN
01601               NPOIN_P(IDD)=NPOIN_P(IDD)+1
01602               NODELG(NODE,IDD)=NPOIN_P(IDD)
01603             END IF
01604           END DO
01605         END DO
01606       END DO
01607 !D    ALLOCATION AND FILLING OF  THE NODEGL ARRAY
01608       MAX_NPOIN_P=MAXVAL(NPOIN_P)
01609 
01610       WRITE(LU,*) 'NB MAX OF POINT PER SUBDOMAIN :', MAX_NPOIN_P
01611       WRITE(LU,*) 'NB OF POINT PER SUBDOMAIN :'
01612       DO I=1,NPARTS
01613         WRITE(LU,*) I, NPOIN_P(I)
01614       ENDDO
01615 !
01616       ALLOCATE(NODEGL(MAX_NPOIN_P,NPARTS),STAT=IERR)
01617       CALL CHECK_ALLOCATE(IERR,'NODEGL')
01618       NODEGL(:,:)=0
01619       DO IDD=1,NPARTS
01620         DO NODE=1,NPOINT
01621           IF (NODELG(NODE,IDD) .NE. 0) THEN
01622             NODEGL(NODELG(NODE,IDD),IDD)=NODE
01623           END IF
01624         END DO
01625       END DO
01626 !
01627 !----------------------------------------------------------------------
01628 ! 5A. ALLOCATIONS POUR ECRITURE DES FICHIERS .UNV/.LOG ASSOCIANT UN SOUS-DOMAINE
01629 !     PAR PROC
01630 !------------
01631 
01632       NAMEINP2=NAMEINP
01633       NAMELOG2=NAMELOG
01634       BLANC='    '
01635       MOINS1='-1'
01636       ALLOCATE(NODES4(NPOINT),STAT=IERR)
01637       CALL CHECK_ALLOCATE(IERR,' NODES4')
01638 !$$$      NODES4(:)=-1
01639       ALLOCATE(KNOLG(NPOINT),STAT=IERR)      ! C'EST SOUS-OPTIMAL EN
01640       CALL CHECK_ALLOCATE(IERR,' KNOLG')! TERME DE DIMENSIONNEMENT
01641       KNOLG(:)=-1      ! MAIS PLUS RAPIDE POUR LE REMPLISSAGE ULTERIEUR
01642 !
01643 ! PARAMETRE NBSDOMVOIS (NOMBRE DE SOUS DOMAINES VOISINS+2)
01644 !
01645       ALLOCATE(NACHB(NBSDOMVOIS,NPOINT),STAT=IERR)
01646       CALL CHECK_ALLOCATE(IERR,' NACHB')
01647       NACHB(1,:)=0
01648       DO J=2,NBSDOMVOIS-1
01649         NACHB(J,:)=-1
01650       ENDDO
01651       ALLOCATE(TRIUNV(4*NBTRI),STAT=IERR)
01652       CALL CHECK_ALLOCATE(IERR, 'TRIUNV')
01653 !
01654 !
01655 ! 5B. RECHERCHE DE LA VRAI COULEUR AUX NOEUDS POUR EVITER LES PBS DE DIRICHLET
01656 !     AUX INTERFACES
01657 !---------------
01658       NCOLOR2(:)=-1
01659       DO J=1,NPOINT      ! BOUCLE SUR TOUS LES POINTS DU MAILLAGES
01660         NI=NODES2T(J)
01661         NF=NI+NODES1T(J)-1
01662 
01663         DO N=NI,NF       ! BOUCLE SUR LES TETRA CONTENANT LE POINT J
01664           NUMTET=NODES3T(N)   ! TRIA DE NUMERO LOCAL NUMTET
01665           NUMTRIG=CONVTRI(NUMTET)  ! NUMERO GLOBAL DU TRIANGLE
01666           COLOR1=ECOLOR(NUMTRIG)   ! COULEUR DU NOEUD AVEC CE TRIA
01667           COLOR2=NCOLOR2(J)
01668 
01669           IF (COLOR2 > 0) THEN   ! ON PRIORISE LES COULEURS
01670             PR1=0
01671             PR2=0
01672             DO L=1,NBCOLOR
01673               IF (PRIORITY(L)==COLOR1) THEN
01674                 PR1=L
01675               ENDIF
01676               IF (PRIORITY(L)==COLOR2) THEN
01677                 PR2=L
01678               ENDIF
01679             ENDDO
01680             IF ((PR1==0).OR.(PR2==0)) GOTO 154
01681             IF (PR1<PR2) NCOLOR2(J)=COLOR1  ! ON CHANGE DE COULEUR
01682           ELSE        ! PREMIERE FOIS QUE CE NOEUD EST TRAITE
01683             NCOLOR2(J)=COLOR1
01684           ENDIF
01685         ENDDO
01686       ENDDO
01687 
01688       CALL SYSTEM_CLOCK(COUNT=TEMPS_SC(7),COUNT_RATE=PARSEC)
01689 
01690 !      DO IELEM = 1, NPOINT
01691 !         WRITE(LU,*) 'NCOLOR2',NCOLOR2(IELEM)
01692 !      ENDDO
01693 
01694 !      DO IELEM = 1, NBCOLOR
01695 !         WRITE(LU,*) 'PRIOR',PRIORITY(IELEM)
01696 !      ENDDO
01697 !
01698 ! OB D
01699 !--------------
01700 ! RAJOUT POUR TENIR COMPTE DES COULEURS DES NOEUDS DE TETRAS LIES
01701 ! AU TRIA DE BORD ET SITUES DANS D'AUTRES SD
01702 !--------------
01703 !
01704       ALLOCATE(TETCOLOR(NBTET,4),STAT=IERR)
01705       CALL CHECK_ALLOCATE(IERR,' TETCOLOR')
01706       TETCOLOR(:,:)=.FALSE.
01707       NBRETOUCHE=0
01708       DO IPTFR=1,NPTFR      ! BOUCLE SUR TOUS LES POINTS DE BORD
01709         J=NBOR(IPTFR)
01710 !       ON NE FAIT QQE CHOSE (EVENTUELLEMENT) QUE SI IL Y A UN TRIA
01711 !       DE BORD (ECOLOR>0 ET NCOLOR2 !=-1). GRACE AU TRAITEMENT PRECEDENT
01712 !       ON S'EN REND COMPTE DIRECTEMENT VIA NCOLOR2.
01713         LINTER=.FALSE.
01714         NBTETJ=NODES1(J) ! NBRE DE TETRA RATTACHES A CE NOEUD
01715         NI=NODES2(J)     ! ADRESSE DANS NODES3 DU PREMIER
01716         NF=NI+NBTETJ-1
01717         IF (NCOLOR2(J) > 0) THEN
01718 !         ON CHERCHE A SAVOIR SI LE NOEUD EST A L'INTERFACE LINTER=.TRUE.
01719           DO N=NI,NF       ! BOUCLE SUR LES TETRA CONTENANT LE POINT J
01720             NT=NODES3(N)   ! TETRA DE NUMERO LOCAL NT
01721             IF (N.EQ.NI) THEN
01722               IDDNT=EPART(NT)
01723             ELSE
01724               IF (EPART(NT) /= IDDNT) THEN
01725                 LINTER=.TRUE.
01726                 GOTO 20     ! ON A LE RENSEIGNEMENT DEMANDE, ON SORT
01727               ENDIF
01728             ENDIF
01729           ENDDO          ! FIN BOUCLE SUR LES TETRAS
01730    20     CONTINUE
01731 !         LE NOEUD J EST UN NOEUD D'INTERFACE. ON VA COMMUNIQUER AU NOEUD
01732 !         CORRESPONDANT DES TETRAS (SI UN TRIA DE BORD N'EST PAS SUR CETTE
01733 !         FACE AUXQUEL CAS LE PB EST DEJA REGLE), LA BONNE COULEUR.
01734           IF (LINTER) THEN
01735             DO N=NI,NF       ! BOUCLE SUR LES TETRA CONTENANT LE POINT J
01736               NT=NODES3(N)   ! TETRA DE NUMERO LOCAL NT
01737 !         ON VA TRIER LES CAS NON PATHOLOGIQUES ET TRES COURANT DE TETRA
01738 !         DONT UNE FACE COINCIDE AVEC CE TRIANGLE
01739               IF (TETTRI2(NT)>0) THEN   !TETRA CONCERNE PAR UN TRIA
01740                 NIT=4*(NT-1)+1
01741                 NFT=NIT+TETTRI2(NT)-1
01742                 DO MT=NIT,NFT           ! BOUCLE SUR LES TRIA DU TETRA
01743                   NUMTRI=TETTRI(MT)     ! NUM LOCAL DU TRIA
01744                   NUMTRIB=3*(NUMTRI-1)+1
01745                   IKLE1=IKLESTRI(NUMTRIB) ! NUMERO GLOBAUX DES NOEUDS DU TRIA
01746                   IKLE2=IKLESTRI(NUMTRIB+1)
01747                   IKLE3=IKLESTRI(NUMTRIB+2)
01748 !                 CE POINT J APPARTIENT DEJA A UN TRIA ACOLLE AU TETRA
01749 !                 ON SAUTE LE TETRA NT
01750                   IF ((IKLE1==J).OR.(IKLE2==J).OR.(IKLE3==J)) THEN
01751 ! POUR TESTS
01752 !                    WRITE(LU,*)'JE SAUTE LE TETRA ',NT,EPART(NT),
01753 !     &                          TETTRI2(NT),' NODES ',J
01754                     GOTO 21
01755                   ENDIF
01756                 ENDDO
01757               ENDIF            ! FIN SI TETTRI
01758 !             LE TETRA NT EST POTENTIELLEMENT OUBLIE, ON LE TRAITE AU CAS OU
01759 !             LE PARTAGE SE FERA DANS ESTEL3D/READ_CONNECTIVITY
01760               NUMTETB=4*(NT-1)+1
01761               DO L=1,4
01762                 IKLE1=IKLESTET(NUMTETB+L-1) ! NUMERO GLOBAUX DES NOEUDS DU TETRA
01763                 IF (IKLE1==J) THEN
01764                   TETCOLOR(NT,L)=(TETCOLOR(NT,L).OR..TRUE.)
01765                   NBRETOUCHE=NBRETOUCHE+1
01766                 ENDIF
01767               ENDDO  ! EN L
01768    21        CONTINUE
01769              ENDDO   ! FIN BOUCLE SUR LES TETRAS
01770           ENDIF   ! FIN SI LINTER
01771         ENDIF             ! FIN SI SUR NCOLOR2
01772       ENDDO              ! FIN BOUCLE SUR LES POINTS DE BORD
01773 ! OB F
01774       CALL SYSTEM_CLOCK(COUNT=TEMPS_SC(8),COUNT_RATE=PARSEC)
01775       WRITE(LU,*)' NOMBRE DE RETOUCHE DU PARTITIONNEMENT (PART2): ',
01776      &           NBRETOUCHE
01777       WRITE(LU,*)' TEMPS DE RETOUCHE DU PARTITIONNEMENT PART1/PART2',
01778      &            (1.0*(TEMPS_SC(7)-TEMPS_SC(6)))/(1.0*PARSEC),'/',
01779      &           (1.0*(TEMPS_SC(8)-TEMPS_SC(7)))/(1.0*PARSEC),' SECONDS'
01780 !$$$      WRITE(LU,*)'IDEM VERSION DE REFERENCE'
01781 
01782 ! 5C. REMPLISSAGE EFFECTIF DU UNV PAR SD
01783 !---------------
01784       IBID = 1
01785 !
01786       IF (NELIN .GT. 0) THEN
01787         ALLOCATE(DEJA_TROUVE(NELIN),STAT=IERR)
01788       ELSE
01789         ALLOCATE(DEJA_TROUVE(1),STAT=IERR)
01790       ENDIF
01791       CALL CHECK_ALLOCATE(IERR,'DEJA_TROUVE')
01792       DEJA_TROUVE(:)=.FALSE.
01793 !
01794 !     INITIALISATION OF THE SIZE OF THE FILE'S NAME
01795       I_LENINP = LEN_TRIM(NAMEINP2)
01796       I_LENLOG = LEN_TRIM(NAMELOG2)
01797 !
01798       DO IDD=1,NPARTS  ! BOUCLE SUR LES SOUS-DOMAINES
01799 
01800 ! NOMBRE DE TRIANGLES POUR CE SOUS-DOMAINE
01801         NBTRIIDD=0
01802 ! NOM DU FICHIER UNV PAR SOUS-DOMAINE
01803         NAMEINP2(I_LENINP+1:I_LENINP+11) = EXTENS(NPARTS-1,IDD-1)
01804         OPEN(NINP2,FILE=NAMEINP2,STATUS='UNKNOWN',FORM='FORMATTED',
01805      &       ERR=132)
01806         REWIND(NINP2)
01807 
01808 ! NOM DU FICHIER LOG PAR SOUS-DOMAINE
01809         NAMELOG2(I_LENLOG+1:I_LENLOG+11) = EXTENS(NPARTS-1,IDD-1)
01810         OPEN(NLOG2,FILE=NAMELOG2,STATUS='UNKNOWN',FORM='FORMATTED',
01811      &       ERR=133)
01812         REWIND(NLOG2)
01813 
01814 ! TITRE (UNV PAR SD)
01815         WRITE(NINP2,60,ERR=112)BLANC,MOINS1
01816         WRITE(NINP2,61,ERR=112)NSEC1
01817         WRITE(NINP2,62,ERR=112)TITRE
01818         TITRE = ' '
01819         WRITE(NINP2,62,ERR=112)TITRE
01820         WRITE(NINP2,62,ERR=112)TITRE
01821         WRITE(NINP2,62,ERR=112)TITRE
01822         WRITE(NINP2,62,ERR=112)TITRE
01823         WRITE(NINP2,62,ERR=112)TITRE
01824         WRITE(NINP2,62,ERR=112)TITRE
01825         WRITE(NINP2,60,ERR=112)BLANC,MOINS1
01826 !
01827 ! BLOC SUR LES COORDONNEES/COULEURS DES NOEUDS (UNV PAR SD)
01828         WRITE(NINP2,60,ERR=112)BLANC,MOINS1
01829         WRITE(NINP2,61,ERR=112)NSEC2
01830         COMPT=1
01831         NODES4(:)=-1
01832 !D      NEW VERSION OF THE LOOP TO REDUCE THE COMPUTING TIME
01833         DO POS_NODE=1,NPOIN_P(IDD) ! BOUCLE SUR TOUS LES POINTS DU MAILLAGES
01834           J=NODEGL(POS_NODE,IDD)
01835 !D       PREVIOUS VERSION OF THE LOOP
01836 !D       NI=NODES2(J)
01837 !D       NF=NI+NODES1(J)-1
01838 !D       DO N=NI,NF       ! BOUCLE SUR LES TETRA CONTENANT LE POINT J
01839 !D           NT=NODES3(N)   ! TETRA DE NUMERO LOCAL NT
01840 !D           IF (EPART(NT)==IDD) THEN     ! C'EST UNE MAILLE DU SOUS-DOMAINE
01841           WRITE(NINP2,63,ERR=112)COMPT,IBID,IBID,NCOLOR2(J)
01842           WRITE(NINP2,64,ERR=112)X1(J),Y1(J),Z1(J)
01843           NODES4(J)=COMPT   ! LE NOEUD J A LE NUMERO COMPT
01844                                 ! POUR LE SOUS-DOMAINE IDD
01845 ! POUR PARALLELISME TELEMAC
01846           KNOLG(COMPT)=J ! CONVERSION SD (LOCAL)-->MAILLAGE ENTIER (GLOBAL)
01847           K=NACHB(1,J)   ! NBRE DE SD CONTENANT LE NOEUD J
01848           NACHBLOG=.TRUE.
01849           DO L=1,K     ! NOEUD DEJA CONCERNE PAR CE SD ?
01850             IF (NACHB(1+L,J)==IDD) NACHBLOG=.FALSE.  ! OUI
01851           ENDDO
01852           IF (NACHBLOG) THEN                         ! NON
01853             K=NACHB(1,J)+1
01854             IF (K.GT.NBSDOMVOIS-2) GOTO 151
01855             NACHB(K+1,J)=IDD  ! NOEUD GLOBAL J CONCERNE PAR IDD
01856             NACHB(1,J)=K      ! SA MULTIPLICITE
01857           ENDIF
01858           COMPT=COMPT+1
01859 !          GOTO 10 ! ON PASSE AU NOEUD SUIVANT
01860 !            ENDIF  ! EN EPART
01861 !          ENDDO ! EN N
01862 !   10     CONTINUE
01863         ENDDO   ! EN J
01864 ! POUR TESTS
01865 !      DO I=1,NPOINT
01866 !        WRITE(LU,*)'GLOBAL NUMERO POINT: ',I,' LOCAL: ',NODES4(I)
01867 !      ENDDO
01868         NPOINTSD(IDD)=COMPT-1  ! NOMBRE DE NOEUDS DU SOUS-DOMAINE IDD
01869         WRITE(NINP2,60,ERR=112)BLANC,MOINS1
01870 
01871 ! BLOC SUR LES CONNECTIVITES/COULEURS DES MAILLES (UNV PAR SD)
01872         WRITE(NINP2,60,ERR=112)BLANC,MOINS1
01873         WRITE(NINP2,61,ERR=112)NSEC3
01874         COMPT=1
01875         IBID = 1
01876 !D      PREVIOUS VERSION OF THE LOOP
01877 !D      DO J=1,NELEMTOTAL
01878 !D      IF (TYPELEM(J,1)==111) THEN ! C'EST UN TETRAEDRE
01879 !D        NUMTET=TYPELEM(J,2) ! NUM LOCAL DU TETRA DANS LA LISTE DES TETRAS
01880 !D            IF (EPART(NUMTET)==IDD) THEN
01881 
01882         DO POS=1,NELEM_P(IDD)
01883                                 ! BOUCLE SUR TETRA ET TRIA POUR ECOLOR
01884           J=ELEGL(POS,IDD)
01885           NUMTET=TYPELEM(J,2)  ! NUM LOCAL DU TETRA DANS LA LISTE DES TETRAS
01886           ELEM=111
01887 ! OB D
01888 ! PRETRAITEMENT POUR LES EVENTUELS PB DE COULEURS DES NOEUDS DE TETRAS
01889 ! A L'INTERFACE
01890           IBIDC=0
01891           IF (TETCOLOR(NUMTET,1)) IBIDC=IBIDC+1000
01892           IF (TETCOLOR(NUMTET,2)) IBIDC=IBIDC+ 200
01893           IF (TETCOLOR(NUMTET,3)) IBIDC=IBIDC+  30
01894           IF (TETCOLOR(NUMTET,4)) IBIDC=IBIDC+   4
01895 ! POUR MONITORING
01896 !              IF (IBIDC/=0) WRITE(6,*)'IDD',IDD,'PARTEL',J,COMPT,IBIDC
01897 ! IDEM VERSION DE REFERENCE
01898 !             IBIDC=0
01899 ! OB F
01900           WRITE(NINP2,65,ERR=112)COMPT,ELEM,-IBIDC,IBID,ECOLOR(J),4
01901           IF (ECOLOR(J).LE.0) PRINT*,'PB WRITE COLOR',J,ECOLOR(J)
01902           COMPT=COMPT+1
01903           N=4*(NUMTET-1)+1
01904           IKLE1=NODES4(IKLESTET(N))
01905           IKLE2=NODES4(IKLESTET(N+1))
01906           IKLE3=NODES4(IKLESTET(N+2))
01907           IKLE4=NODES4(IKLESTET(N+3))
01908           WRITE(NINP2,66,ERR=112)IKLE1,IKLE2,IKLE3,IKLE4
01909           IF ((IKLE1.LT.0).OR.(IKLE2.LT.0).OR.(IKLE3.LT.0)
01910      &        .OR.(IKLE4.LT.0)) GOTO 147
01911           IF (TETTRI2(NUMTET).NE.0) THEN
01912             NI=4*(NUMTET-1)+1
01913             NF=NI+TETTRI2(NUMTET)-1
01914             DO M=NI,NF   ! ON PARCOURT LES TRIANGLES DE BORD ASSOCIES
01915               NUMTRI=TETTRI(M)  ! AU NUMTET TETRAEDRE; NUM LOCAL DU TRIA
01916               NUMTRIG=CONVTRI(NUMTRI)  ! NUMERO GLOBAL DU TRIANGLE
01917               ELEM=91
01918               TRIUNV(4*NBTRIIDD+1)=ECOLOR(NUMTRIG)
01919               N=3*(NUMTRI-1)+1
01920               IKLE1=NODES4(IKLESTRI(N))
01921               IKLE2=NODES4(IKLESTRI(N+1))
01922               IKLE3=NODES4(IKLESTRI(N+2))
01923               TRIUNV(4*NBTRIIDD+2)=IKLE1
01924               TRIUNV(4*NBTRIIDD+3)=IKLE2
01925               TRIUNV(4*NBTRIIDD+4)=IKLE3
01926               NBTRIIDD=NBTRIIDD+1
01927 !
01928               IF ((IKLE1.LT.0).OR.(IKLE2.LT.0).OR.(IKLE3.LT.0))
01929      &           GOTO 147
01930 !
01931             ENDDO  ! EN M
01932           ENDIF  ! EN TETTRI2
01933         ENDDO ! EN J
01934 
01935 ! MAINTENANT ON PEUX RECOPIER LE BLOC DES TRIANGLES !
01936         ELEM=91
01937         DO J=1,NBTRIIDD
01938           WRITE(NINP2,65,ERR=112)COMPT,ELEM,IBID,IBID,
01939      &                           TRIUNV(4*(J-1)+1),3
01940           IKLE1=TRIUNV(4*(J-1)+2)
01941           IKLE2=TRIUNV(4*(J-1)+3)
01942           IKLE3=TRIUNV(4*(J-1)+4)
01943           WRITE(NINP2,67,ERR=112)IKLE1,IKLE2,IKLE3
01944           COMPT=COMPT+1
01945         ENDDO  ! EN J
01946 !
01947         ELEM=91
01948 ! BOUCLE SURDIMENSIONNEE, ON BOUCLE SUR LE NOMBRE DE SURFACE INTERNE DU MAILLAGE GLOBAL...
01949         IF (NELIN .GT. 0) THEN
01950           DO J=1,NELIN
01951             IF (DEJA_TROUVE(J)) CYCLE
01952             IKLE1=NODES4(IKLEIN(J,2))
01953             IKLE2=NODES4(IKLEIN(J,3))
01954             IKLE3=NODES4(IKLEIN(J,4))
01955             IF ((IKLE1.EQ.-1).OR.(IKLE2.EQ.-1).OR.(IKLE3.EQ.-1)) CYCLE
01956             !
01957             ! MODIF STOBIAC
01958             FOUND_TET = .FALSE.
01959             !
01960             ! ON BOUCLE SUR LES TETRA DE CHAQUE NOEUD POUR VERIFIER QUE LES TROIS POINTS
01961             ! APPARTIENNENT A UN TETRAEDRE DE LA PARTITION
01962             !
01963             ! PASSAGE A LA NUMEROTATION GLOBALE
01964             PTRI1 = NODEGL(IKLE1,IDD)
01965             PTRI2 = NODEGL(IKLE2,IDD)
01966             PTRI3 = NODEGL(IKLE3,IDD)
01967             !
01968             DEB1 = NODES2(PTRI1)
01969             FIN1 = DEB1 + NODES1(PTRI1)-1
01970             DEB2 = NODES2(PTRI2)
01971             FIN2 = DEB2 + NODES1(PTRI2)-1
01972             DEB3 = NODES2(PTRI3)
01973             FIN3 = DEB3 + NODES1(PTRI3)-1
01974             !
01975             DO PTET1 = DEB1, FIN1
01976               DO PTET2 = DEB2, FIN2
01977                 IF (NODES3(PTET1).EQ.NODES3(PTET2)) THEN
01978                   DO PTET3 = DEB3, FIN3
01979                     IF (NODES3(PTET3).EQ.NODES3(PTET1)) THEN
01980                       IF (EPART(NODES3(PTET3)).EQ.IDD) THEN
01981                         FOUND_TET = .TRUE.
01982                       ENDIF
01983                     ENDIF
01984                     IF (FOUND_TET) EXIT
01985                   ENDDO
01986                 ENDIF
01987                 IF (FOUND_TET) EXIT
01988               ENDDO
01989               IF (FOUND_TET) EXIT
01990             ENDDO
01991             !
01992             IF (.NOT.FOUND_TET) CYCLE
01993             ! END MODIF STOBIAC
01994             !
01995             WRITE(NINP2,65,ERR=112) COMPT,ELEM,IBID,IBID,IKLEIN(J,1),3
01996             WRITE(NINP2,67,ERR=112) IKLE1,IKLE2,IKLE3
01997             COMPT = COMPT+1
01998             DEJA_TROUVE(J) = .TRUE.
01999           ENDDO ! EN J
02000         ENDIF
02001 !
02002 !$$$        WRITE(LU,*) 'SUBDOMAIN',IDD,'INNERTRI',COMPT
02003 !
02004         WRITE(NINP2,60,ERR=112)BLANC,MOINS1
02005 !        WRITE(NINP2,60,ERR=112)BLANC,MOINS1
02006 !        WRITE(NINP2,61,ERR=112)NSEC4
02007 !        WRITE(NINP2,68,ERR=112) 1,0,0,0,0,0,0,0
02008         CLOSE(NINP2)
02009         NELEMSD(IDD)=COMPT-1  ! NOMBRE DE MAILLES DU SOUS-DOMAINE IDD
02010 
02011 ! 5D. REMPLISSAGE EFFECTIF DU LOG PAR SD
02012 !---------------
02013 ! ELEMENT STANDARD DU FICHIER LOG (LOG PAR SD)
02014         WRITE(NLOG2,51 ,ERR=113) NPOINTSD(IDD)
02015         WRITE(NLOG2,52 ,ERR=113) NELEMSD(IDD)
02016         WRITE(NLOG2,523,ERR=113) SIZE_FLUX
02017 
02018 !       BEGIN MODIF V STOBIAC
02019 !       READ FAMILIES
02020 #if defined (HAVE_MED)
02021         IF (FORMAT_MED) THEN
02022           WRITE(NLOG2,53 ,ERR=113) NBFAMILY
02023           DO J=1,NBFAMILY+1
02024             WRITE(NLOG2,50,ERR=113)'--'
02025           ENDDO
02026         ENDIF
02027 #endif
02028         IF (.NOT.FORMAT_MED) THEN
02029           WRITE(NLOG2,53 ,ERR=113) NBFAMILY-1
02030           DO J=1,NBFAMILY
02031             WRITE(NLOG2,50,ERR=113)'--'
02032           ENDDO
02033         ENDIF
02034 !       END MODIF V STOBIAC
02035 
02036         ! ADDITION BY JP RENAUD ON 15/02/2007
02037         ! AS THE LIST OF PRIORITIES HAS MOVED IN ESTEL-3D FROM
02038         ! THE STEERING FILE TO THE LOG FILE, WE NEED TO WRITE "A"
02039         ! NUMBER OF EXTERNAL FACES + PRIORITY LIST HERE. AS THESE
02040         ! ARE NOT USED IN PARALLEL MODE, WE MERELY COPY THE LIST
02041         ! FROM THE ORIGINAL LOG FILE.
02042 
02043         WRITE(NLOG2,531,ERR=113) NBCOLOR
02044         WRITE(UNIT=THEFORMAT,FMT=1000) NBCOLOR
02045 1000    FORMAT('(''PRIORITY :'',',I3,'(X,I3,))')
02046         THEFORMAT=TRIM(THEFORMAT)
02047 !        WRITE(LU,*) 'FORMATT =',THEFORMAT
02048         WRITE (NLOG2,FMT=THEFORMAT(1:LEN(THEFORMAT)-1))
02049      &  (PRIORITY(I), I=1, NBCOLOR)
02050 
02051         ! END ADDITION BY JP RENAUD
02052 
02053 ! KNOLG (LOG PAR SD)
02054         NT=NPOINTSD(IDD)
02055         NI=NT/6
02056         NF=NT-6*NI
02057         WRITE(NLOG2,54,ERR=113)NI,NF
02058         DO J=1,NI
02059           WRITE(NLOG2,540,ERR=113)(KNOLG(6*(J-1)+K),K=1,6)
02060         ENDDO
02061         IF (NF.EQ.1) THEN
02062           WRITE(NLOG2,541,ERR=113)KNOLG(6*NI+1)
02063         ELSE IF (NF.EQ.2) THEN
02064           WRITE(NLOG2,542,ERR=113)(KNOLG(6*NI+K),K=1,2)
02065         ELSE IF (NF.EQ.3) THEN
02066           WRITE(NLOG2,543,ERR=113)(KNOLG(6*NI+K),K=1,3)
02067         ELSE IF (NF.EQ.4) THEN
02068           WRITE(NLOG2,544,ERR=113)(KNOLG(6*NI+K),K=1,4)
02069         ELSE IF (NF.EQ.5) THEN
02070           WRITE(NLOG2,545,ERR=113)(KNOLG(6*NI+K),K=1,5)
02071         ENDIF
02072         WRITE(NLOG2,55,ERR=113)NPOINT  ! NOMBRE DE NOEUD DU MAILLAGE
02073                     ! INITIAL POUR ALLOCATION KNOGL DANS ESTEL
02074 !
02075       ENDDO  ! BOUCLE SUR LES SOUS-DOMAINES
02076 
02077       DEALLOCATE(CONVTRI)
02078       DEALLOCATE(TYPELEM)
02079 
02080 ! 5E. TRAVAUX SUPPLEMENTAIRES POUR DETERMINER LE NACHB AVANT DE L'ECRIRE
02081 !      DANS LE LOG
02082 !---------------
02083       DO IDD=1,NPARTS  ! BOUCLE SUR LES SOUS-DOMAINES
02084 ! CONSTRUCTION ET DIMENSIONNEMENT DU NACHB PROPRE A CHAQUE SD
02085         COMPT=0
02086         NACHB(NBSDOMVOIS,:)=-1
02087         DO J=1,NPOINT      ! BOUCLE SUR TOUS LES POINTS DU MAILLAGE
02088           N=NACHB(1,J)
02089           IF (N>1) THEN    ! POINT D'INTERFACE
02090             N=N+1
02091             DO K=2,N
02092               IF (NACHB(K,J)==IDD) THEN ! IL CONCERNE IDD
02093                 COMPT=COMPT+1   ! "COMPT"IEME POINT D'INTERFACE DE IDD
02094                 NACHB(NBSDOMVOIS,J)=COMPT  ! A RETENIR COMME POINT D'INTERFACE
02095               ENDIF
02096             ENDDO            ! FIN BOUCLE SUR LES SD DU POINT J
02097           ENDIF
02098         ENDDO              ! FIN BOUCLE POINTS
02099         NPOINTISD(IDD)=COMPT ! NOMBRE DE POINTS D'INTERFACE DE IDD
02100 
02101 ! 5F. ON CONTINUE L'ECRITURE DU .LOG
02102 !-------------
02103         NAMELOG2(I_LENLOG+1:I_LENLOG+11) = EXTENS(NPARTS-1,IDD-1)
02104         OPEN(NLOG2,FILE=NAMELOG2,STATUS='OLD',FORM='FORMATTED',
02105      &       POSITION='APPEND',ERR=133)
02106         WRITE(NLOG2,56,ERR=113) NPOINTISD(IDD)
02107         DO J=1,NPOINT
02108           IF (NACHB(NBSDOMVOIS,J)>0) THEN  ! C'EST UN POINT D'INTERFACE DE IDD
02109             COMPT=0
02110             VECTNB(:)=-1
02111             DO K=1,NBSDOMVOIS-2    ! ON PREPARE L'INFO POUR LE NACHB TELEMAC
02112               IF (NACHB(K+1,J)/= IDD) THEN
02113                 COMPT=COMPT+1
02114 ! ATTENTION A CELUI-CI, SUREMENT LIE AU NUMERO DE POINTS...
02115 ! OB D
02116                 IF (COMPT.GT.NBSDOMVOIS-3) GOTO 152
02117 ! OB F
02118                 IF (NACHB(K+1,J)>0) THEN
02119 ! ON STOCKE LE NUMERO DE PROC ET NON LE NUMERO DE SOUS-DOMAINE
02120 ! D'OU LA CONTRAINTE, UN PROC PAR SOUS-DOMAINE
02121                   VECTNB(COMPT)=NACHB(K+1,J)-1
02122                 ENDIF
02123               ENDIF
02124             ENDDO  ! EN K
02125 !           WRITE(NLOG2,561,ERR=113)J,(VECTNB(K),K=1,NBSDOMVOIS-3)
02126             NT = NBSDOMVOIS-3
02127             NI=NT/6
02128             NF=NT-6*NI+1
02129             WRITE(NLOG2,640,ERR=113)NODELG(J,IDD),(VECTNB(K),K=1,5)
02130 !            WRITE(NLOG2,640,ERR=113)J,(VECTNB(K),K=1,5)
02131             DO L=2,NI
02132               WRITE(NLOG2,640,ERR=113)(VECTNB(6*(L-1)+K),K=0,5)
02133             ENDDO
02134             IF (NF.EQ.1) THEN
02135               WRITE(NLOG2,641,ERR=113)VECTNB(6*NI)
02136             ELSEIF (NF.EQ.2) THEN
02137               WRITE(NLOG2,642,ERR=113)(VECTNB(6*NI+K),K=0,1)
02138             ELSEIF (NF.EQ.3) THEN
02139               WRITE(NLOG2,643,ERR=113)(VECTNB(6*NI+K),K=0,2)
02140             ELSEIF (NF.EQ.4) THEN
02141               WRITE(NLOG2,644,ERR=113)(VECTNB(6*NI+K),K=0,3)
02142             ELSEIF (NF.EQ.5) THEN
02143               WRITE(NLOG2,645,ERR=113)(VECTNB(6*NI+K),K=0,4)
02144             ENDIF
02145           ENDIF
02146         ENDDO  ! FIN BOUCLE EN J
02147         WRITE(NLOG2,57,ERR=113)
02148         CLOSE(NLOG2)
02149       ENDDO  ! BOUCLE SUR LES SOUS-DOMAINES
02150       CALL SYSTEM_CLOCK(COUNT=TEMPS_SC(9),COUNT_RATE=PARSEC)
02151       WRITE(LU,*)' REMPLISSAGE DES FICHIERS UNV ET LOG',
02152      &           (1.0*(TEMPS_SC(9)-TEMPS_SC(8)))/(1.0*PARSEC),' SECONDS'
02153 !----------------------------------------------------------------------
02154 ! 6. AFFICHAGES DANS PARTEL.LOG ET TEST DE COMPLETUDE DU PARTITIONNEMENT
02155 !------------
02156 
02157       WRITE(LU,*)' '
02158       COMPT1=0
02159       COMPT2=0
02160       COMPT3=0
02161       DO IDD=1,NPARTS
02162         WRITE(LU,86)IDD,NELEMSD(IDD),NPOINTSD(IDD),NPOINTISD(IDD)
02163         COMPT3=COMPT3+NPOINTISD(IDD)
02164         COMPT2=COMPT2+NPOINTSD(IDD)
02165         COMPT1=COMPT1+NELEMSD(IDD)
02166       ENDDO
02167       WRITE(LU,*)' ------------------------------------'
02168       WRITE(LU,87)COMPT1,COMPT2,COMPT3
02169       WRITE(LU,88)COMPT1/NPARTS,COMPT2/NPARTS,COMPT3/NPARTS
02170       WRITE(LU,*)' '
02171       WRITE(LU,83)(1.0*(TEMPS_SC(9)-TEMPS_SC(1)))/(1.0*PARSEC)
02172       WRITE(LU,*)' ENDING METIS MESH PARTITIONING--------------------+'
02173       WRITE(LU,*)' '
02174       WRITE(LU,*)' WRITING GEOMETRY FILE FOR EACH PROCESSOR'
02175       WRITE(LU,*)' WRITING LOG FILE FOR EACH PROCESSOR'
02176 
02177 !----------------------------------------------------------------------
02178 ! 7. DIVERS
02179 !---------------
02180 
02181 ! 7.A FORMAT DU LOG
02182 !---------------
02183    50 FORMAT(A80)         ! LES AUTRES LIGNES
02184 !             1234567890123456789012345678901234567890123456789
02185    51 FORMAT(' TOTAL NO. OF NODES                   :    ',I10)
02186    52 FORMAT(' TOTAL NO. OF ELEMENTS                :    ',I10)
02187   523 FORMAT(' TOTAL NO. OF USER-FLUX               :    ',I10)
02188    53 FORMAT(' TOTAL NO. OF FAMILIES                :    ',I10)
02189   531 FORMAT(' TOTAL NUMBER OF EXTERNAL FACES       :    ',I10)
02190    54 FORMAT(' DEBUT DE KNOLG: ',I10,' ',I10)
02191 
02192   540 FORMAT(6I10)        ! LIGNE DE BLOC KNOLG ET PRIORITY
02193   541 FORMAT(I10)         ! DERNIERE LIGNE DE BLOC KNOLG
02194   542 FORMAT(2I10)        ! DERNIERE LIGNE DE BLOC KNOLG
02195   543 FORMAT(3I10)        ! DERNIERE LIGNE DE BLOC KNOLG
02196   544 FORMAT(4I10)        ! DERNIERE LIGNE DE BLOC KNOLG
02197   545 FORMAT(5I10)        ! DERNIERE LIGNE DE BLOC KNOLG
02198 
02199   641 FORMAT(I9)         ! DERNIERE LIGNE DE BLOC NACHB
02200   642 FORMAT(2I9)        ! DERNIERE LIGNE DE BLOC NACHB
02201   643 FORMAT(3I9)        ! DERNIERE LIGNE DE BLOC NACHB
02202   644 FORMAT(4I9)        ! DERNIERE LIGNE DE BLOC NACHB
02203   645 FORMAT(5I9)        ! DERNIERE LIGNE DE BLOC NACHB
02204   640 FORMAT(6I9)        ! DERNIERE LIGNE DE BLOC NACHB
02205 
02206 
02207 
02208    55 FORMAT(' FIN DE KNOLG: ',I10)
02209    56 FORMAT(' DEBUT DE NACHB: ',I10)
02210    57 FORMAT(' FIN DE NACHB: ')
02211 
02212 ! 7B. FORMAT DU UNV
02213 !---------------
02214    60 FORMAT(A4,A2)       ! '    -1'
02215    61 FORMAT(I9)          ! LECTURE NSEC
02216    62 FORMAT(A80)         ! LECTURE TITRE
02217    63 FORMAT(4I10)        ! LIGNE 1 BLOC COORD
02218    64 FORMAT(3D25.16)     ! LIGNE 2 BLOC COORD
02219    65 FORMAT(6I10)        ! LIGNE 1 BLOC CONNECTIVITE
02220    66 FORMAT(4I10)        ! LIGNE 2 BLOC CONNECTIVITE SI TETRA
02221    67 FORMAT(3I10)        ! LIGNE 2 BLOC CONNECTIVITE SI TRIANGLE
02222 !  68 FORMAT(8I10)        ! BLOC FANTOCHE POUR MARQUER LA FIN DU BLOC
02223                           ! CONNECTIVITEE
02224 
02225 ! 7.C AFFICHAGES DANS PARTEL.LOG
02226 !---------------
02227    80 FORMAT(' #NUMBER TOTAL OF ELEMENTS: ',I8,
02228      &       ' #NODES                 : ',I8)
02229    81 FORMAT(' #TETRAHEDRONS            : ',I8,
02230      &       ' #TRIANGLE MESH BORDER  : ',I8)
02231    82 FORMAT(' #NPARTS                : ',I8)
02232    83 FORMAT('  RUNTIME                 : ',F10.2,' S')
02233    86 FORMAT('  DOMAIN: ',I3,' #ELEMENTS:   ',I8,' #NODES:   ',I8,
02234      &       ' #INTERFACENODES:   ',I8)
02235    87 FORMAT('  TOTAL VALUES OF ELEMENTS: ',I10,'  NODES: ',I10,
02236      &       '  INTERFACENODES: ',I10)
02237    88 FORMAT('  MEAN VALUES OF ELEMENTS :   ',I8,'  NODES:   ',I8,
02238      &       '  INTERFACENODES:   ',I8)
02239    89 FORMAT('  INPUT UNV FILE      :',A50)
02240 !  90 FORMAT('  INPUT LOG FILE      :',A50)
02241 !  91 FORMAT('  NUMBER OF PARTITIONS:',I5)
02242    92 FORMAT('  NUMBER OF NODES:',I10)
02243    93 FORMAT('  NUMBER OF ELEMENTS:',I10)
02244    94 FORMAT('  NUMBER OF COLORS:',I5)
02245 
02246 ! 7.D DEALLOCATE
02247 !---------------
02248       DEALLOCATE(X1,Y1,Z1)
02249       DEALLOCATE(ECOLOR)
02250       DEALLOCATE(IKLESTET,IKLESTRI,TETTRI,TETTRI2)
02251       DEALLOCATE(EPART,NPART)
02252       DEALLOCATE(NELEMSD,NPOINTSD,NPOINTISD)
02253       DEALLOCATE(NODES1,NODES2,NODES3,NODES4,TRIUNV)
02254       DEALLOCATE(NODES1T,NODES2T,NODES3T)
02255       DEALLOCATE(KNOLG,NACHB,PRIORITY,NCOLOR2)
02256       DEALLOCATE(ELEGL)
02257       DEALLOCATE(NODEGL)
02258       DEALLOCATE(NODELG)
02259       DEALLOCATE(NELEM_P)
02260       DEALLOCATE(NPOIN_P)
02261       RETURN
02262 
02263 ! 7.E MESSAGES D'ERREURS
02264 !---------------
02265 
02266   111 TEXTERROR='! UNEXPECTED FILE FORMAT2: '//NAMEINP//' !'
02267       GOTO 999
02268   112 TEXTERROR='! UNEXPECTED FILE FORMAT3: '//NAMEINP2//' !'
02269       GOTO 999
02270   113 TEXTERROR='! UNEXPECTED FILE FORMAT4: '//NAMELOG2//' !'
02271       GOTO 999
02272   120 TEXTERROR='! UNEXPECTED EOF WHILE READING: '//NAMELOG//' !'
02273       GOTO 999
02274   130 TEXTERROR='! PROBLEM WHILE OPENING: '//NAMELOG//' !'
02275       GOTO 999
02276   131 TEXTERROR='! PROBLEM WHILE OPENING: '//NAMEINP//' !'
02277       GOTO 999
02278   132 TEXTERROR='! PROBLEM WHILE OPENING: '//NAMEINP2//' !'
02279       GOTO 999
02280   133 TEXTERROR='! PROBLEM WHILE OPENING: '//NAMELOG2//' !'
02281       GOTO 999
02282   140 TEXTERROR='! FILE DOES NOT EXIST: '//NAMEINP//' !'
02283       GOTO 999
02284   141 TEXTERROR='! FILE DOES NOT EXIST: '//NAMELOG//' !'
02285       GOTO 999
02286   144 WRITE(UNIT=STR8,FMT='(I8)')MAXLENSOFT
02287       TEXTERROR='! NAME OF INPUT FILE '//NAMEINP//' IS LONGER THAN '//
02288      &           STR8(1:3)//' CHARACTERS !'
02289       GOTO 999
02290   145 WRITE(UNIT=STR8,FMT='(I8)')MAXLENSOFT
02291       TEXTERROR='! NAME OF INPUT FILE '//NAMELOG//' IS LONGER THAN '//
02292      &           STR8(1:3)//' CHARACTERS !'
02293       GOTO 999
02294   146 TEXTERROR='! PROBLEM WITH CONSTRUCTION OF INVERSE CONNECTIVITY !'
02295       GOTO 999
02296   147 TEXTERROR='! PROBLEM WHILE WRITING: '//NAMEINP2//' !'
02297       GOTO 999
02298   149 TEXTERROR='! NO INPUT UNV FILE !'
02299       GOTO 999
02300   151 WRITE(UNIT=STR8,FMT='(I8)')J
02301       WRITE(UNIT=STR26,FMT='(I3,1X,I3,1X,I3,1X,I3,1X,I3,1X,I3)')
02302      &                 (NACHB(K,J),K=2,NBSDOMVOIS-1),IDD
02303       TEXTERROR='! NODE '//STR8//' BELONGS TO DOMAINS '//STR26(1:23)
02304      &                 //' !'
02305       GOTO 999
02306   152 TEXTERROR='! PROBLEM WITH CONSTRUCTION OF VECTNB FOR NACHB !'
02307       GOTO 999
02308   154 TEXTERROR='! PROBLEM WITH THE PRIORITY OF COLOR NODES !'
02309       GOTO 999
02310 ! END OF FILE AND FORMAT ERRORS :
02311  1100 TEXTERROR='ERREUR DE LECTURE DU FICHIER UNV '//
02312      &  'VIA MESH_CONNECTIVITY'
02313       GOTO 999
02314  1200 TEXTERROR='ERREUR DE FIN DE LECTURE DU FICHIER UNV '//
02315      &  'VIA MESH_CONNECTIVITY'
02316       GOTO 999
02317 
02318   999 WRITE(LU,*) TEXTERROR
02319 !
02320       END SUBROUTINE PARES3D

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