gredelseg_autop.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\gretel\gredelseg_autop.f
00002 !
00071                      PROGRAM GREDELSEG_AUTOP
00072 !                    ***********************
00073 !
00074 !
00075 !***********************************************************************
00076 ! PARALLEL   V7P0                                   27/03/2014
00077 !***********************************************************************
00078 !
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00088 !
00089       USE BIEF, ONLY : NCSIZE
00090       IMPLICIT NONE
00091       INTEGER LNG,LU
00092       INTEGER LI
00093       COMMON/INFO/LNG,LU
00094 !
00095       CHARACTER(LEN=30) GEO
00096 !
00097       INTEGER IPID,ERR,FU
00098       INTEGER NELEM,ECKEN,NDUM,I,J,K,NBV1,NBV2,PARAM(10)
00099       INTEGER NPLAN,NPOIN2,NPOIN2LOC,NOQ2,NPLANLOC,NSEG2LOC,NOQ2LOC
00100       INTEGER MBNDLOC,NPTFRLOC
00101       INTEGER NPROC,NRESU,NPOINMAX,NSEGMAX,NOQMAX,NPTFRMAX
00102       INTEGER I_S, I_SP, I_LEN
00103       INTEGER IT
00104       INTEGER IDUM, NPTFR
00105       INTEGER IELM,NELEM2,NELMAX2,NPTFR2,NSEG2,KLOG,MBND2
00106       INTEGER MAXNVOIS,ISEG,IG1,IG2,IGTEMP,IVOIS,IL1,IL2
00107 !
00108       INTEGER, DIMENSION(:)  , ALLOCATABLE :: NPOIN,VERIF,NOQ,NSEG
00109       INTEGER, DIMENSION(:)  , ALLOCATABLE :: MBND,NODENRS,NPTFRL
00110       INTEGER, DIMENSION(:,:), ALLOCATABLE :: KNOLG,KSEGLG
00111       INTEGER, DIMENSION(:,:), ALLOCATABLE :: NODENRSLOC,NBORLOC
00112       INTEGER, DIMENSION(:,:), ALLOCATABLE :: LIHBORLOC
00113       INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLESA
00114       INTEGER, DIMENSION(:,:), ALLOCATABLE :: NACHB,IFANUM
00115       INTEGER, DIMENSION(:), ALLOCATABLE :: ISEGF
00116 !
00117 !
00118       REAL   , DIMENSION(:)  , ALLOCATABLE :: GLOBAL_VALUE
00119       REAL   , DIMENSION(:)  , ALLOCATABLE :: LOCAL_VALUE
00120 !
00121       INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLE       ! IKLE(SIZIKL,*) OU IKLE(NELMAX,*)
00122       INTEGER, DIMENSION(:,:), ALLOCATABLE :: IFABOR     ! IFABOR(NELMAX,*) OU IFABOR(NELMAX2,*)
00123       INTEGER, DIMENSION(:)  , ALLOCATABLE :: NVOIS,IADR ! NVOIS(NPOIN),IADR(NPOIN)
00124 !
00125       INTEGER, DIMENSION(:)  , ALLOCATABLE :: NELBOR,LIHBOR      ! NELBOR(NPTFR),LIHBOR(NPTFR)
00126       INTEGER, DIMENSION(:,:), ALLOCATABLE :: NULONE             ! NULONE(NPTFR,2) OU NULONE(NPTFR)
00127       INTEGER, DIMENSION(:,:), ALLOCATABLE :: KP1BOR             ! KP1BOR(NPTFR,2) OU KP1BOR(NPTFR)
00128       INTEGER, DIMENSION(:)  , ALLOCATABLE :: NBOR               ! NBOR(*)
00129       INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLBOR             ! IKLBOR(NPTFR,2)
00130       INTEGER, DIMENSION(:)  , ALLOCATABLE :: T3                 ! T3(NPOIN)
00131       INTEGER, DIMENSION(:)  , ALLOCATABLE :: NBOR0,LIHBOR0      ! NBOR0(NPTFR),LIHBOR0(NPTFR)
00132 !
00133       INTEGER, DIMENSION(:,:), ALLOCATABLE :: GLOSEG         ! GLOSEG(MAXSEG,2)
00134       INTEGER, DIMENSION(:,:), ALLOCATABLE :: ELTSEG,ORISEG  ! ELTSEG(NELMAX,*),ORISEG(NELMAX,3)
00135 !
00136       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: GLOSEGLOC
00137       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: SEGMENT
00138 !
00139       REAL RDUM
00140 !
00141       LOGICAL IS,ENDE
00142 !
00143       CHARACTER*30 RES
00144       CHARACTER*50 RESPAR
00145       CHARACTER*11 EXTENS
00146       CHARACTER*30 CONLIM
00147       CHARACTER*7  FILETYPE
00148       EXTERNAL    EXTENS
00149       INTRINSIC MAXVAL
00150 !
00151       LI=5
00152       LU=6
00153       LNG=2
00154 !HW
00155 !JAJ INTRODUCE YOURSELF WITH THE RELEASE DATE
00156 !
00157       WRITE(LU,*) 'I AM GREDELSEG, COUSIN OF GRETEL FROM BAW HAMBURG'
00158       WRITE(LU,*)
00159 !
00160 ! READS FILENAMES AND THE NUMBER OF PROCESSORS / PARTITIONS
00161 !
00162       WRITE (LU, ADVANCE='NO',
00163      &    FMT='(/,'' GLOBAL GEOMETRY FILE: '')')
00164 !      REWIND(LI)
00165       READ(LI,*) GEO
00166       WRITE(LU,*) GEO
00167 !
00168       WRITE (LU, ADVANCE='NO', FMT='(/,'' RESULT FILE: '')')
00169       READ(LI,*) RES
00170       WRITE(LU,*) RES
00171 !
00172       WRITE (LU,ADVANCE='NO',FMT='(/,'' NUMBER OF PROCESSORS: '')')
00173       READ (LI,*) NPROC
00174       WRITE(LU,*) NPROC
00175 !
00176       INQUIRE (FILE=GEO,EXIST=IS)
00177       IF (.NOT.IS) THEN
00178         WRITE (LU,*) 'FILE DOES NOT EXIST: ', GEO
00179         CALL PLANTE(1)
00180         STOP
00181       END IF
00182 !
00183       I_S  = LEN (RES)
00184       I_SP = I_S + 1
00185       DO I=1,I_S
00186         IF(RES(I_SP-I:I_SP-I) .NE. ' ') EXIT
00187       ENDDO
00188       I_LEN=I_SP - I
00189 !
00190 !     GEOMETRY FILE, READ UNTIL 10 PARAMETERS:
00191 !
00192       OPEN(2,FILE=GEO,FORM='UNFORMATTED',STATUS='OLD',ERR=990)
00193       READ(2,ERR=990)
00194       READ(2,ERR=990) NBV1,NBV2
00195       DO I=1,NBV1+NBV2
00196         READ(2,ERR=990)
00197       ENDDO ! I
00198       GO TO 992
00199 990   WRITE(LU,*) 'ERROR WHEN OPENING OR READING FILE: ',GEO
00200       CALL PLANTE(1)
00201       STOP
00202 992   CONTINUE
00203 !     READS THE 10 PARAMETERS AND THE DATE
00204       READ(2) (PARAM(I),I=1,10)
00205       IF(PARAM(10).EQ.1) READ(2) (PARAM(I),I=1,6)
00206 !
00207 !     RESULTS FILE:
00208 !
00209       OPEN(3,FILE=RES,FORM='UNFORMATTED',ERR=991)
00210       GO TO 993
00211 991   WRITE(LU,*) 'ERROR WHEN OPENING FILE: ',RES
00212       CALL PLANTE(1)
00213       STOP
00214 993   CONTINUE
00215 !
00216 !     1) READS THE BEGINNING OF THE FIRST RESULTS FILE
00217 !
00218 !CC      RESPAR=RES // EXTENS(2**IDIMS-1,0)
00219 !
00220       RESPAR=RES(1:I_LEN) // EXTENS(NPROC-1,0)
00221 !
00222       INQUIRE (FILE=RESPAR,EXIST=IS)
00223       IF (.NOT.IS) THEN
00224         WRITE (LU,*) 'FILE DOES NOT EXIST: ', RESPAR
00225         WRITE (LU,*) 'CHECK THE NUMBER OF PROCESSORS'
00226         WRITE (LU,*) 'AND THE RESULT FILE CORE NAME'
00227         CALL PLANTE(1)
00228         STOP
00229       END IF
00230 !
00231       OPEN(4,FILE=RESPAR,FORM='UNFORMATTED',ERR=994)
00232       GO TO 995
00233 994   WRITE(LU,*) 'ERROR WHEN OPENING FILE: ',RESPAR
00234       CALL PLANTE(1)
00235       STOP
00236 995   CONTINUE
00237 !
00238       READ(4) FILETYPE
00239       READ(4) NPOIN2
00240       READ(4) NSEG2LOC
00241       READ(4) MBNDLOC
00242       READ(4) NOQ2LOC
00243       READ(4) NPLAN
00244       IF(NPLAN.EQ.1) NPLAN = 0
00245 !
00246       CLOSE(4)
00247 !
00248 !  5 : 4 PARAMETERS
00249 !
00250       READ(2) NELEM,NPOIN2,ECKEN,NDUM
00251       WRITE(LU,*) '4 PARAMETERS IN GEOMETRY FILE'
00252       WRITE(LU,*) 'NELEM=',  NELEM
00253       WRITE(LU,*) 'NPOIN2=', NPOIN2
00254       WRITE(LU,*) 'ECKEN=',  ECKEN
00255       WRITE(LU,*) 'NDUM=',   NDUM
00256 !
00257 !  DYNAMICALLY ALLOCATES THE ARRAYS
00258 !
00259       ALLOCATE(NPOIN(NPROC),STAT=ERR)
00260       CALL CHECK_ALLOCATE(ERR, 'NPOIN')
00261       ALLOCATE(NOQ(NPROC),STAT=ERR)
00262       CALL CHECK_ALLOCATE(ERR, 'NOQ')
00263       ALLOCATE(NSEG(NPROC),STAT=ERR)
00264       CALL CHECK_ALLOCATE(ERR, 'NSEG')
00265       ALLOCATE(MBND(NPROC),STAT=ERR)
00266       CALL CHECK_ALLOCATE(ERR, 'MBND')
00267       ALLOCATE(IKLESA(3,NELEM),STAT=ERR)
00268       CALL CHECK_ALLOCATE(ERR, 'IKLESA')
00269       ALLOCATE(NODENRS(NPOIN2),STAT=ERR)
00270       CALL CHECK_ALLOCATE(ERR, 'NODENRS')
00271       ALLOCATE(NPTFRL(NPROC),STAT=ERR)
00272       CALL CHECK_ALLOCATE(ERR, 'NPTFR2LOC')
00273 !
00274       ALLOCATE(IFABOR(NELEM,3),STAT=ERR)
00275       CALL CHECK_ALLOCATE(ERR, 'IFABOR')
00276       ALLOCATE(IKLE(NELEM,3),STAT=ERR)
00277       CALL CHECK_ALLOCATE(ERR, 'IKLE')
00278       ALLOCATE(IADR(NPOIN2),STAT=ERR)
00279       CALL CHECK_ALLOCATE(ERR, 'IADR')
00280       ALLOCATE(NVOIS(NPOIN2),STAT=ERR)
00281       CALL CHECK_ALLOCATE(ERR, 'NVOIS')
00282       ALLOCATE(T3(NPOIN2),STAT=ERR)
00283       CALL CHECK_ALLOCATE(ERR, 'T3')
00284 !
00285 !  END OF ALLOCATION ...
00286 !
00287 !  6 : IKLE
00288 !
00289       READ(2)  ((IKLESA(I,J),I=1,ECKEN),J=1,NELEM)
00290 !
00291 !----------------------------------------------------------------------
00292 !
00293 !
00294       IF(NPLAN.LE.1) THEN
00295         CONLIM = "T2DCLI"
00296       ELSE
00297         CONLIM = "T3DCLI"
00298       ENDIF
00299 !
00300       OPEN(4,FILE=CONLIM,FORM='FORMATTED',ERR=996)
00301       GO TO 997
00302  996  WRITE(LU,*) 'ERROR WHEN OPENING FILE: ',CONLIM
00303       CALL PLANTE(1)
00304       STOP
00305  997  CONTINUE
00306 !
00307       ALLOCATE(LIHBOR0(NPOIN2),STAT=ERR)
00308       CALL CHECK_ALLOCATE(ERR, 'LIHBOR')
00309       ALLOCATE(NBOR0(NPOIN2),STAT=ERR)
00310       CALL CHECK_ALLOCATE(ERR, 'NBOR')
00311       DO I=1,NPOIN2
00312         READ(4,*,END=989) LIHBOR0(I),IDUM,IDUM,RDUM,RDUM,RDUM,RDUM,
00313      &                    IDUM,RDUM,RDUM,RDUM,NBOR0(I),IDUM
00314       ENDDO
00315 !
00316       CLOSE(4)
00317  989  NPTFR=I-1
00318 !
00319       ALLOCATE(LIHBOR(NPTFR),STAT=ERR)
00320       CALL CHECK_ALLOCATE(ERR, 'LIHBOR')
00321       ALLOCATE(NBOR(NPTFR),STAT=ERR)
00322       CALL CHECK_ALLOCATE(ERR, 'NBOR')
00323       ALLOCATE(NELBOR(NPTFR),STAT=ERR)
00324       CALL CHECK_ALLOCATE(ERR, 'NELBOR')
00325       ALLOCATE(NULONE(NPTFR,2),STAT=ERR)
00326       CALL CHECK_ALLOCATE(ERR, 'NULONE')
00327       ALLOCATE(KP1BOR(NPTFR,2),STAT=ERR)
00328       CALL CHECK_ALLOCATE(ERR, 'KP1BOR')
00329       ALLOCATE(IKLBOR(NPTFR,2),STAT=ERR)
00330       CALL CHECK_ALLOCATE(ERR, 'IKLBOR')
00331       ALLOCATE(ELTSEG(NELEM,3),STAT=ERR)
00332       CALL CHECK_ALLOCATE(ERR, 'ELTSEG')
00333       ALLOCATE(ORISEG(NELEM,3),STAT=ERR)
00334       CALL CHECK_ALLOCATE(ERR, 'ORISEG')
00335 !
00336       MBND2=0
00337 !
00338       DO I=1,NPOIN2
00339         NODENRS(I) = I
00340       ENDDO
00341 !
00342       DO I=1,NPTFR
00343         NBOR(I)   = NBOR0(I)
00344         LIHBOR(I) = LIHBOR0(I)
00345         IF (LIHBOR(I).NE.2) THEN
00346           MBND2 = MBND2 + 1
00347           NODENRS(NBOR(I)) = -MBND2
00348         ENDIF
00349       ENDDO
00350 !
00351 !------------------------------------------------------------------------------
00352 !
00353 ! LOCAL CONSTRUCTION OF GLOSEG
00354 !
00355 !------------------------------------------------------------------------------
00356 !
00357 !     WITH PRISMS, DIFFERENT FROM 2D VALUES, OTHERWISE
00358 !
00359       IELM = 11 ! WARNING: IS HARD-CODED !!!
00360         NELEM2  =NELEM
00361         NELMAX2 =NELEM
00362         NPTFR2  =NPTFR
00363 !
00364 !     NEIGHBOURS OF THE BOUNDARY SIDES FOR TRIANGULAR MESH
00365 !
00366         DO J=1,NELEM
00367           DO I=1,3
00368             IKLE(J,I)=IKLESA(I,J)
00369           ENDDO
00370         ENDDO
00371       NCSIZE = 1
00372       IF(IELM.EQ.11.OR.IELM.EQ.41.OR.IELM.EQ.51) THEN
00373         ! DUMMY ARRAY
00374         ALLOCATE(NACHB(1,1),STAT=ERR)
00375         CALL CHECK_ALLOCATE(ERR, 'NACHB')
00376 !
00377         CALL VOISIN(IFABOR,NELEM2,NELEM,IELM,IKLE,
00378      &              NELEM,
00379      &              NPOIN2,NACHB,NBOR,NPTFR,IADR,NVOIS)
00380 !
00381         DEALLOCATE(NACHB)
00382         MAXNVOIS = MAXVAL(NVOIS)/2
00383       ELSE
00384         WRITE(LU,*) 'UNEXPECTED ELEMENT IN INBIEF:',IELM
00385         CALL PLANTE(1)
00386         STOP
00387       ENDIF
00388       KLOG = 2 ! SOLID BOUNDARY CONDITION: IS HARD-CODED !!!
00389       IF(IELM.EQ.11.OR.IELM.EQ.41.OR.IELM.EQ.51) THEN
00390         ! Dummy arrays
00391         ALLOCATE(IFANUM(1,1),STAT=ERR)
00392         CALL CHECK_ALLOCATE(ERR, 'IFANUM')
00393         ALLOCATE(ISEGF(NPTFR),STAT=ERR)
00394         CALL CHECK_ALLOCATE(ERR, 'ISEG')
00395 !
00396         CALL ELEBD(NELBOR,NULONE,KP1BOR,
00397      &             IFABOR,NBOR,IKLE,NELEM,
00398      &             IKLBOR,NELEM2,NELMAX2,
00399      &             NPOIN2,NPTFR2,IELM,
00400      &             LIHBOR,KLOG,
00401      &             IFANUM,1,ISEGF,
00402      &             IADR,NVOIS,T3,NPTFR2,NPTFR2)
00403 !                                NELEBX,NELEB (HERE EQUAL TO NPTFR2)
00404         DEALLOCATE(IFANUM)
00405         DEALLOCATE(ISEGF)
00406       ELSE
00407         WRITE(LU,*) 'UNEXPECTED ELEMENT IN INBIEF:',IELM
00408         CALL PLANTE(1)
00409         STOP
00410       ENDIF
00411 !
00412 !-----------------------------------------------------------------------
00413 !
00414 !  DATA STRUCTURE FOR EDGE-BASED STORAGE (FROM 5.9 ON ALWAYS DONE IN 2D)
00415 !  SEE CALL TO COMP_SEG BELOW FOR COMPLETING THE STRUCTURE
00416 !
00417       IF(IELM.EQ.11) THEN
00418 !
00419         NSEG2 = (3*NELEM+NPTFR)/2
00420         NOQ2=NPLAN*(NSEG2+MBND2)+(NPLAN-1)*NPOIN2
00421         IF(NPLAN.EQ.0) THEN
00422           ALLOCATE(VERIF(NSEG2+MBND2),STAT=ERR)
00423         ELSE
00424           ALLOCATE(VERIF(NOQ2) ,STAT=ERR)
00425         ENDIF
00426         CALL CHECK_ALLOCATE(ERR, 'VERIFSEG')
00427 !
00428 !  GLOBAL_VALUES, STORES THE WHOLE DATASET (NBV1-VALUES)
00429         IF(NPLAN.EQ.0) THEN
00430           ALLOCATE(GLOBAL_VALUE(NSEG2+MBND2),STAT=ERR)
00431         ELSE
00432           ALLOCATE(GLOBAL_VALUE(NOQ2),STAT=ERR)
00433         ENDIF
00434         CALL CHECK_ALLOCATE(ERR, 'GLOBAL_VALUE')
00435 !
00436         ALLOCATE(GLOSEG(NSEG2,2),STAT=ERR)
00437         CALL CHECK_ALLOCATE(ERR, 'GLOSEG')
00438 !
00439       ! DUMMY ARRAY
00440         ALLOCATE(KNOLG(1,1),STAT=ERR)
00441         CALL CHECK_ALLOCATE(ERR, 'KNOLG')
00442 
00443         CALL STOSEG(IFABOR,NELEM,NELMAX2,NELMAX2,IELM,IKLE,
00444      &            NBOR,NPTFR,
00445      &            GLOSEG,NSEG2,    ! GLOSEG%MAXDIM1,
00446      &            ELTSEG,ORISEG,NSEG2,
00447      &            NELBOR,NULONE,KNOLG(:,1),IKLBOR,NPTFR,NPTFR)
00448         DEALLOCATE(KNOLG)
00449       ENDIF
00450 !
00451       ALLOCATE(SEGMENT(NPOIN2,MAXNVOIS,2),STAT=ERR)
00452       CALL CHECK_ALLOCATE(ERR, 'SEGMENT')
00453 !
00454 ! INITIALISES SEGMENT
00455       DO K=1,2
00456         DO J=1,MAXNVOIS
00457           DO I=1,NPOIN2
00458             SEGMENT(I,J,K) = 0
00459           ENDDO
00460         ENDDO
00461       ENDDO
00462 !
00463       DO ISEG=1,NSEG2
00464         IG1 = GLOSEG(ISEG,1)
00465         IG2 = GLOSEG(ISEG,2)
00466 ! GLOBAL NUMBERS IN INCREASING ORDER
00467         IF(IG1.GT.IG2) THEN
00468           IGTEMP = IG1
00469           IG1 = IG2
00470           IG2 = IGTEMP
00471         ENDIF
00472         IVOIS=1
00473         DO WHILE ((SEGMENT(IG1,IVOIS,1).NE.0).AND.(IVOIS.LE.MAXNVOIS))
00474           IVOIS = IVOIS + 1
00475         ENDDO
00476         SEGMENT(IG1,IVOIS,1) = IG2
00477         SEGMENT(IG1,IVOIS,2) = ISEG
00478       ENDDO
00479 !
00480 ! OPENS FILES AND READS/SKIPS HEADERS -> NPOIN(NPROC), NPOINMAX
00481 !
00482       DO IPID = 0,NPROC-1
00483         FU = IPID +10
00484         RESPAR=RES(1:I_LEN) // EXTENS(NPROC-1,IPID)
00485         OPEN (FU,FILE=RESPAR,FORM='UNFORMATTED',ERR=998)
00486         GO TO 999
00487 998     WRITE(LU,*) 'ERROR WHEN OPENING FILE: ',RESPAR,
00488      &                     ' USING FILE UNIT: ', FU
00489         CALL PLANTE(1)
00490         STOP
00491 999     REWIND(FU)
00492         READ(FU) FILETYPE
00493         READ(FU) NPOIN(IPID+1)
00494         READ(FU) NSEG(IPID+1)
00495         READ(FU) MBND(IPID+1)
00496         READ(FU) NOQ(IPID+1)
00497         READ(FU) NPLANLOC
00498         READ(FU) NPTFRL(IPID+1)
00499       END DO
00500 !
00501       NPOINMAX = MAXVAL(NPOIN)
00502       NSEGMAX = MAXVAL(NSEG)
00503       NOQMAX = MAXVAL(NOQ)
00504       NPTFRMAX = MAXVAL(NPTFRL)
00505 !     ARRAY FOR LOCAL-GLOBAL NUMBERS, 2D-FIELD
00506       ALLOCATE (GLOSEGLOC(NSEGMAX,2,NPROC),STAT=ERR)
00507       IF(NPLAN.EQ.0) THEN
00508         ALLOCATE(KNOLG(NPOINMAX,NPROC),STAT=ERR)
00509         ALLOCATE(KSEGLG(NSEGMAX,NPROC),STAT=ERR)
00510         ALLOCATE(NODENRSLOC(NPOINMAX,NPROC),STAT=ERR)
00511         ALLOCATE(NBORLOC(NPTFRMAX,NPROC),STAT=ERR)
00512         ALLOCATE(LIHBORLOC(NPTFRMAX,NPROC),STAT=ERR)
00513       ELSE
00514         ALLOCATE(KNOLG(NPOINMAX/NPLAN,NPROC),STAT=ERR)
00515         ALLOCATE(KSEGLG(NOQMAX,NPROC),STAT=ERR)
00516         ALLOCATE(NODENRSLOC(NPOINMAX/NPLAN,NPROC),STAT=ERR)
00517         ALLOCATE(NBORLOC(NPTFRMAX,NPROC),STAT=ERR)
00518         ALLOCATE(LIHBORLOC(NPTFRMAX,NPROC),STAT=ERR)
00519       ENDIF
00520       CALL CHECK_ALLOCATE(ERR, 'KNOLG')
00521       CALL CHECK_ALLOCATE(ERR, 'KSEGLG')
00522       CALL CHECK_ALLOCATE(ERR, 'NODENRSLOC')
00523       CALL CHECK_ALLOCATE(ERR, 'NBORLOC')
00524 !  LOCAL_VALUES, STORES THE WHOLE DATASET (NBV1-VALUES)
00525       ALLOCATE(LOCAL_VALUE(NOQMAX),STAT=ERR)
00526       CALL CHECK_ALLOCATE(ERR, 'LOCAL_VALUE')
00527 !
00528 ! READS KNOLG(NPOIN,NPROC)
00529 !
00530       IF(NPLAN.EQ.0) THEN
00531         DO I=1,NSEG2+MBND2
00532           VERIF(I)=0
00533         ENDDO
00534       ELSE
00535         DO I=1,NOQ2
00536           VERIF(I)=0
00537         ENDDO
00538       ENDIF
00539 !
00540       DO IPID = 0,NPROC-1
00541         FU = IPID +10
00542 ! CHECKS
00543         IF(NPLAN.EQ.0) THEN
00544           READ(FU) (KNOLG(I,IPID+1),I=1,NPOIN(IPID+1))
00545           READ(FU) ((GLOSEGLOC(I,J,IPID+1),J=1,2),I=1,NSEG(IPID+1))
00546           READ(FU) (NODENRSLOC(I,IPID+1),I=1,NPOIN(IPID+1))
00547           READ(FU) (NBORLOC(I,IPID+1),I=1,NPTFRL(IPID+1))
00548           READ(FU) (LIHBORLOC(I,IPID+1),I=1,NPTFRL(IPID+1))
00549         ELSE
00550           READ(FU) (KNOLG(I,IPID+1),I=1,NPOIN(IPID+1)/NPLAN)
00551           READ(FU) ((GLOSEGLOC(I,J,IPID+1),J=1,2),I=1,NSEG(IPID+1))
00552           READ(FU) (NODENRSLOC(I,IPID+1),I=1,NPOIN(IPID+1)/NPLAN)
00553           READ(FU) (NBORLOC(I,IPID+1),I=1,NPTFRL(IPID+1))
00554           READ(FU) (LIHBORLOC(I,IPID+1),I=1,NPTFRL(IPID+1))
00555         ENDIF
00556 !
00557 ! INITIALISES SEGMENT
00558 !
00559         DO ISEG=1,NSEG(IPID+1)
00560           IL1 = GLOSEGLOC(ISEG,1,IPID+1)
00561           IL2 = GLOSEGLOC(ISEG,2,IPID+1)
00562           IG1 = KNOLG(IL1,IPID+1)
00563           IG2 = KNOLG(IL2,IPID+1)
00564 !         GLOBAL NUMBER IN INCREASING ORDER
00565           IF(IG1.GT.IG2) THEN
00566             IGTEMP = IG1
00567             IG1 = IG2
00568             IG2 = IGTEMP
00569           ENDIF
00570           IVOIS=1
00571           DO WHILE ((SEGMENT(IG1,IVOIS,1).NE.IG2)
00572      &              .AND.(IVOIS.LE.MAXNVOIS))
00573             IVOIS = IVOIS + 1
00574           ENDDO
00575           IF(IVOIS.LE.MAXNVOIS) THEN
00576             KSEGLG(ISEG,IPID+1) = SEGMENT(IG1,IVOIS,2)
00577           ENDIF
00578         ENDDO
00579 !
00580       ENDDO
00581 !
00582 ! FURTHER VERIFICATIONS
00583 !
00584 ! READS DATASETS
00585 !
00586       NRESU = 0
00587 !
00588 2000  NRESU = NRESU + 1
00589 !
00590       IF(NPLAN.EQ.0) THEN
00591         DO I=1,NSEG2+MBND2
00592           VERIF(I)=0
00593         ENDDO
00594       ELSE
00595         DO I=1,NOQ2
00596           VERIF(I)=0
00597         ENDDO
00598       ENDIF
00599 !
00600       WRITE(LU,*)'TRY TO READ DATASET NO.',NRESU
00601 !
00602       IF(NPLAN.EQ.0) THEN
00603         DO I=1,NSEG2+MBND2
00604           GLOBAL_VALUE(I) = 0.D0
00605         ENDDO
00606       ELSE
00607         DO I=1,NOQ2
00608           GLOBAL_VALUE(I) = 0.D0
00609         ENDDO
00610       ENDIF
00611 !
00612       DO IPID = 0,NPROC-1
00613         FU = IPID +10
00614 !       READS LOCAL X INSTEAD OF GREDELSEG_READ_DATASET
00615         CALL GREDELPTS_READ_DATASET
00616      &  (LOCAL_VALUE,NOQMAX,NOQ(IPID+1),IT,FU,ENDE)
00617         IF (ENDE) GOTO 3000
00618 !       STORES EACH DATASET
00619         IF(NPLAN.EQ.0) THEN
00620           NSEG2LOC  = NSEG(IPID+1)
00621           NPTFRLOC  = NPTFRL(IPID+1)
00622           DO I=1,NSEG2LOC
00623             GLOBAL_VALUE(KSEGLG(I,IPID+1)) =
00624      &      GLOBAL_VALUE(KSEGLG(I,IPID+1)) + LOCAL_VALUE(I)
00625             VERIF(KSEGLG(I,IPID+1)) =   VERIF(KSEGLG(I,IPID+1))
00626      &                                   + 1
00627           ENDDO
00628 !
00629           DO I=1,NPTFRLOC
00630             IF(LIHBORLOC(I,IPID+1).NE.2) THEN
00631               IF(FILETYPE(1:7).EQ.'SUMAREA') THEN
00632                 GLOBAL_VALUE(-NODENRS(KNOLG(NBORLOC(I,IPID+1),IPID+1))
00633      &                       + NSEG2) =
00634      &          LOCAL_VALUE(-NODENRSLOC(NBORLOC(I,IPID+1),IPID+1)
00635      &                      + NSEG2LOC)
00636                 VERIF( -NODENRS(KNOLG(NBORLOC(I,IPID+1),IPID+1))
00637      &                + NSEG2) = 1
00638               ELSEIF(FILETYPE(1:7).EQ.'SUMFLOW') THEN
00639                 GLOBAL_VALUE(-NODENRS(KNOLG(NBORLOC(I,IPID+1),IPID+1))
00640      &                       + NSEG2) =
00641      &          GLOBAL_VALUE(-NODENRS(KNOLG(NBORLOC(I,IPID+1),IPID+1))
00642      &                       + NSEG2) +
00643      &          LOCAL_VALUE(-NODENRSLOC(NBORLOC(I,IPID+1),IPID+1)
00644      &                      + NSEG2LOC)
00645                 VERIF( -NODENRS(KNOLG(NBORLOC(I,IPID+1),IPID+1))
00646      &                + NSEG2) =
00647      &          VERIF( -NODENRS(KNOLG(NBORLOC(I,IPID+1),IPID+1))
00648      &                + NSEG2) + 1
00649               ELSE
00650                 WRITE(LU,*) 'CAS NON PREVU'
00651                 CALL PLANTE(1)
00652                 STOP
00653               ENDIF
00654             ENDIF
00655           ENDDO
00656 !
00657         ELSE
00658           NPOIN2LOC = NPOIN(IPID+1)/NPLAN
00659           NSEG2LOC  = NSEG(IPID+1)
00660           MBNDLOC   = MBND(IPID+1)
00661           NPTFRLOC  = NPTFRL(IPID+1)
00662           DO I=1,NSEG2LOC
00663             DO J=1,NPLAN
00664               GLOBAL_VALUE(KSEGLG(I,IPID+1) + (NSEG2+MBND2)*(J-1)) =
00665      &        GLOBAL_VALUE(KSEGLG(I,IPID+1) + (NSEG2+MBND2)*(J-1)) +
00666      &        LOCAL_VALUE(       I      + (NSEG2LOC+MBNDLOC)*(J-1))
00667               VERIF(KSEGLG(I,IPID+1) + (NSEG2+MBND2)*(J-1)) =
00668      &      + VERIF(KSEGLG(I,IPID+1) + (NSEG2+MBND2)*(J-1)) + 1
00669             END DO
00670           END DO
00671 !
00672           DO I=1,NPTFRLOC
00673             IF(LIHBORLOC(I,IPID+1).NE.2) THEN
00674               DO J=1,NPLAN
00675                 IF(FILETYPE(1:7).EQ.'SUMAREA') THEN
00676                  GLOBAL_VALUE(-NODENRS(KNOLG(NBORLOC(I,IPID+1),IPID+1))
00677      &                        + NSEG2 + (NSEG2+MBND2)*(J-1)) =
00678      &            LOCAL_VALUE(-NODENRSLOC(NBORLOC(I,IPID+1),IPID+1)
00679      &                        + NSEG2LOC + (NSEG2LOC+MBNDLOC)*(J-1))
00680                   VERIF( -NODENRS(KNOLG(NBORLOC(I,IPID+1),IPID+1))
00681      &                  + NSEG2 + (NSEG2+MBND2)*(J-1)) = 1
00682                 ELSEIF(FILETYPE(1:7).EQ.'SUMFLOW') THEN
00683                  GLOBAL_VALUE(-NODENRS(KNOLG(NBORLOC(I,IPID+1),IPID+1))
00684      &                        + NSEG2 + (NSEG2+MBND2)*(J-1)) =
00685      &           GLOBAL_VALUE(-NODENRS(KNOLG(NBORLOC(I,IPID+1),IPID+1))
00686      &                        + NSEG2 + (NSEG2+MBND2)*(J-1)) +
00687      &            LOCAL_VALUE(-NODENRSLOC(NBORLOC(I,IPID+1),IPID+1)
00688      &                        + NSEG2LOC + (NSEG2LOC+MBNDLOC)*(J-1))
00689                   VERIF( -NODENRS(KNOLG(NBORLOC(I,IPID+1),IPID+1))
00690      &                  + NSEG2 + (NSEG2+MBND2)*(J-1)) =
00691      &            VERIF( -NODENRS(KNOLG(NBORLOC(I,IPID+1),IPID+1))
00692      &                  + NSEG2 + (NSEG2+MBND2)*(J-1)) + 1
00693                 ELSE
00694                   WRITE(LU,*) 'CAS NON PREVU'
00695                   CALL PLANTE(1)
00696                   STOP
00697                 ENDIF
00698               ENDDO
00699             ENDIF
00700           ENDDO
00701 !
00702           DO I=1,NPOIN2LOC
00703             DO J=1,NPLAN-1
00704               IF(FILETYPE(1:7).EQ.'SUMAREA') THEN
00705                 GLOBAL_VALUE(  KNOLG(I,IPID+1) + NPOIN2*(J-1)
00706      &                       + (NSEG2+MBND2)*NPLAN) =
00707      &        LOCAL_VALUE(I+NPOIN2LOC*(J-1)+(NSEG2LOC+MBNDLOC)*NPLAN)
00708                 VERIF( KNOLG(I,IPID+1) + NPOIN2*(J-1)
00709      &              + (NSEG2+MBND2)*NPLAN) = 1
00710               ELSEIF(FILETYPE(1:7).EQ.'SUMFLOW') THEN
00711                 GLOBAL_VALUE( KNOLG(I,IPID+1) + NPOIN2*(J-1)
00712      &                       + (NSEG2+MBND2)*NPLAN) =
00713      &          GLOBAL_VALUE( KNOLG(I,IPID+1) + NPOIN2*(J-1)
00714      &                       + (NSEG2+MBND2)*NPLAN) +
00715      &        LOCAL_VALUE(I+NPOIN2LOC*(J-1)+(NSEG2LOC+MBNDLOC)*NPLAN)
00716                 VERIF( KNOLG(I,IPID+1) + NPOIN2*(J-1)
00717      &              + (NSEG2+MBND2)*NPLAN) =
00718      &          VERIF( KNOLG(I,IPID+1) + NPOIN2*(J-1)
00719      &              + (NSEG2+MBND2)*NPLAN) + 1
00720               ELSE
00721                 WRITE(LU,*) 'CAS NON PREVU'
00722                 CALL PLANTE(1)
00723                 STOP
00724               ENDIF
00725             ENDDO
00726           ENDDO
00727         ENDIF
00728       ENDDO
00729 ! WRITES GLOBAL DATASET
00730       WRITE(LU,*)'WRITING DATASET NO.',NRESU,' TIME =',IT
00731 !
00732       IF(NPLAN.EQ.0) THEN
00733         WRITE(3) IT, (GLOBAL_VALUE(I),I=1,NSEG2+MBND2)
00734       ELSE
00735         WRITE(3) IT, (GLOBAL_VALUE(I),I=1,NOQ2)
00736       ENDIF
00737 ! CHECKS ...
00738       IF(NPLAN.EQ.0) THEN
00739         DO I=1,NSEG2+MBND2
00740           IF(VERIF(I).EQ.0) THEN
00741             WRITE(LU,*) 'ERROR, SEGMENT I=',I,' FALSE FOR NRESU=',NRESU
00742           ENDIF
00743         ENDDO
00744       ELSE
00745         DO I=1,NOQ2
00746           IF(VERIF(I).EQ.0) THEN
00747             WRITE(LU,*) 'ERROR, SEGMENT I=',I,' FALSE FOR NRESU=',NRESU
00748           ENDIF
00749         ENDDO
00750       ENDIF
00751 !
00752       GO TO 2000
00753 !
00754 3000  WRITE(LU,*) 'END OF PROGRAM, ',NRESU-1,' DATASETS FOUND'
00755 !
00756       CLOSE(2)
00757       CLOSE(3)
00758 !
00759       DO IPID = 0,NPROC-1
00760         FU = IPID +10
00761         CLOSE (FU)
00762       ENDDO
00763 !
00764       STOP 0
00765       END PROGRAM GREDELSEG_AUTOP

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