gretel_autop.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\gretel\gretel_autop.f
00002 !
00075                      PROGRAM GRETEL_AUTOP
00076 !                    ********************
00077 !
00078 !
00079 !***********************************************************************
00080 ! PARALLEL   V6P2                                   21/08/2010
00081 !***********************************************************************
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !
00091 !
00092 !
00093 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !
00096       IMPLICIT NONE
00097       INTEGER LNG,LU
00098       INTEGER LI
00099       COMMON/INFO/LNG,LU
00100 !
00101       CHARACTER(LEN=30) GEO
00102       INTEGER IPID,ERR,FU
00103       INTEGER NELEM,ECKEN,NDUM,I,J,K,NBV1,NBV2,PARAM(10)
00104       INTEGER NPLAN,NPOIN2,NPOIN2LOC
00105       INTEGER NPROC,NRESU,NPOINMAX
00106       INTEGER I_S, I_SP, I_LEN
00107 !
00108       INTEGER, DIMENSION(:)  , ALLOCATABLE :: NPOIN,IPOBO,VERIF,IPOBO3D
00109       INTEGER, DIMENSION(:,:), ALLOCATABLE :: KNOLG
00110       INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLESA,IKLE3D
00111 !
00112       REAL   , DIMENSION(:,:), ALLOCATABLE :: GLOBAL_VALUE
00113       REAL   , DIMENSION(:,:), ALLOCATABLE :: LOCAL_VALUE
00114       REAL   , DIMENSION(:)  , ALLOCATABLE :: XORIG,YORIG
00115 !
00116       DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: GLOBAL_VALUE_D
00117       DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: LOCAL_VALUE_D
00118       DOUBLE PRECISION, DIMENSION(:)  , ALLOCATABLE :: XORIG_D,YORIG_D
00119 !
00120       REAL AT
00121       DOUBLE PRECISION AT_D
00122 !
00123       LOGICAL IS,ENDE,SERAFIND_GEO,SERAFIND_RES
00124 !
00125       CHARACTER*30 RES
00126       CHARACTER*50 RESPAR
00127       CHARACTER*80 TITSEL
00128       CHARACTER*32 TEXTLU(200)
00129       CHARACTER*11 EXTENS
00130       EXTERNAL  EXTENS
00131       INTRINSIC REAL
00132 !
00133 !-------------------------------------------------------------------------
00134 !
00135       LI=5
00136       LU=6
00137       LNG=2
00138 !HW
00139 !JAJ INTRODUCE YOURSELF WITH THE VERSION DATE
00140 !
00141       WRITE(LU,*) 'I AM GRETEL FROM BAW HAMBURG'
00142       WRITE(LU,*) 'REINCARNATED BY HOLGER WEILBEER'
00143       WRITE(LU,*) 'ON 20TH FEBRUARY 2003'
00144       WRITE(LU,*)
00145 !
00146       WRITE (LU, ADVANCE='NO',
00147      &    FMT='(/,'' GLOBAL GEOMETRY FILE: '')')
00148       READ(LI,*) GEO
00149 !
00150       IF ((GEO.EQ.'E2DSERA').OR.(GEO.EQ.'E2DVOL')
00151      &       .OR.(GEO.EQ.'E2DSCAL')) THEN
00152 !
00153 !|=======================================================================/
00154 !|                                                                       /
00155 !| START: MERGES FILES RESULTING FROM THE PARTICULATE DECOMPOSITION      /
00156 !|                                                                       /
00157 !| SERAFIN  = INCHANGE => MERE COPY OF ONE OF THE NPROC FILES            /
00158 !| VOLFIN   = CHANGE => SUM OF THE RESULTS PART_INS,PART_CUM             /
00159 !| SCALAIRE = CHANGE => SUM OF THE RESULTS NBPART_LOST...                /
00160 !|                                                                       /
00161 !|=======================================================================/
00162 !
00163 !
00164       WRITE(LU,*) 'THE OPTION GEO=',GEO,' HAS BEEN REMOVED'
00165       CALL PLANTE(1)
00166       STOP
00167 !     CALL RECOMPOSITION_PARTICULAIRE(GEO)
00168 !
00169 !
00170 !|==================================================================|
00171 !|                                                                  |
00172 !| END: MERGES FILES RESULTING FROM THE PARTICULATE DECOMPOSITION   |
00173 !|                                                                  |
00174 !|==================================================================|
00175 !
00176 !
00177       ENDIF
00178 !
00179 !
00180 !|==================================================================|
00181 !|                                                                  |
00182 !| START: MERGES FILES RESULTING FROM THE DOMAIN DECOMPOSITION      |
00183 !|                                                                  |
00184 !|==================================================================|
00185 !
00186 ! READS FILE NAMES AND THE NUMBER OF PROCESSORS / PARTITIONS
00187 !
00188       WRITE(LU, ADVANCE='NO', FMT='(/,'' RESULT FILE: '')')
00189       READ(LI,*) RES
00190 !
00191       WRITE (LU,ADVANCE='NO',FMT='(/,'' NUMBER OF PROCESSORS: '')')
00192       READ (LI,*) NPROC
00193       WRITE (LU,*) ' '
00194 !
00195       INQUIRE (FILE=GEO,EXIST=IS)
00196       IF(.NOT.IS) THEN
00197         WRITE (LU,*) 'FILE DOES NOT EXIST: ', GEO
00198         CALL PLANTE(1)
00199         STOP
00200       ENDIF
00201 !
00202       I_S  = LEN (RES)
00203       I_SP = I_S + 1
00204       DO I=1,I_S
00205         IF(RES(I_SP-I:I_SP-I) .NE. ' ') EXIT
00206       ENDDO
00207       I_LEN=I_SP - I
00208 !
00209 !     COMPUTATION GEOMETRY FILE, READ UNTIL THE 10 PARAMETERS:
00210 !
00211       OPEN(2,FILE=GEO,FORM='UNFORMATTED',STATUS='OLD',ERR=990)
00212       READ(2,ERR=990) TITSEL
00213 !
00214       SERAFIND_GEO=.FALSE.
00215       IF(TITSEL(73:80).EQ.'SERAFIND') SERAFIND_GEO=.TRUE.
00216 !
00217       READ(2,ERR=990) NBV1,NBV2
00218       DO I=1,NBV1+NBV2
00219         READ(2,ERR=990)
00220       ENDDO ! I
00221       GO TO 992
00222 990   WRITE(LU,*) 'ERROR WHEN OPENING OR READING FILE: ',GEO
00223       CALL PLANTE(1)
00224       STOP
00225 992   CONTINUE
00226 !     READS THE 10 PARAMETERS AND THE DATE
00227       READ(2) (PARAM(I),I=1,10)
00228       IF(PARAM(10).EQ.1) READ(2) (PARAM(I),I=1,6)
00229 !
00230 !     RESULTS FILE:
00231 !
00232       OPEN(3,FILE=RES,FORM='UNFORMATTED',ERR=991)
00233       GO TO 993
00234 991   WRITE(LU,*) 'ERROR WHEN OPENING FILE: ',RES
00235       CALL PLANTE(1)
00236       STOP
00237 993   CONTINUE
00238 !
00239 !     1) STARTS READING THE 1ST RESULT FILE
00240 !
00241       RESPAR=RES(1:I_LEN) // EXTENS(NPROC-1,0)
00242 !
00243       INQUIRE (FILE=RESPAR,EXIST=IS)
00244       IF (.NOT.IS) THEN
00245         WRITE (LU,*) 'FILE DOES NOT EXIST: ', RESPAR
00246         WRITE (LU,*) 'CHECK THE NUMBER OF PROCESSORS'
00247         WRITE (LU,*) 'AND THE RESULT FILE CORE NAME'
00248         CALL PLANTE(1)
00249         STOP
00250       END IF
00251 !
00252       OPEN(4,FILE=RESPAR,FORM='UNFORMATTED',ERR=994)
00253       GO TO 995
00254 994   WRITE(LU,*) 'ERROR WHEN OPENING FILE: ',RESPAR
00255       CALL PLANTE(1)
00256       STOP
00257 995   CONTINUE
00258 !
00259 !  1 : TITLE
00260 !
00261       READ(4) TITSEL
00262       WRITE(LU,*) 'TITLE=',TITSEL
00263       SERAFIND_RES=.FALSE.
00264       IF(TITSEL(73:80).EQ.'SERAFIND') SERAFIND_RES=.TRUE.
00265       WRITE(3) TITSEL
00266 !
00267 !  2 : NBV1,NBV2
00268 !
00269       READ(4) NBV1,NBV2
00270       WRITE(LU,*) 'NBV1=',NBV1,'   NBV2=',NBV2
00271       WRITE(3) NBV1,NBV2
00272 !
00273 !  3 : NAMES AND UNITS OF THE VARIABLES
00274 !
00275       DO I=1,NBV1
00276         READ(4) TEXTLU(I)
00277         WRITE(LU,*) 'VARIABLE ',I,' : ',TEXTLU(I)
00278         WRITE(3) TEXTLU(I)
00279       ENDDO ! I
00280 !
00281 !  4 : 10 PARAMETERS
00282 !
00283       READ(4) (PARAM(I),I=1,10)
00284       WRITE(LU,*) '10 PARAMETERS : ',PARAM
00285       PARAM(9)=0
00286       PARAM(8)=0
00287       NPLAN=PARAM(7)
00288       WRITE(3) (PARAM(I),I=1,10)
00289 ! READS THE DATE (OPTIONAL) AND WRITES IT OUT
00290       IF(PARAM(10).EQ.1) THEN
00291         READ(4)  (PARAM(I),I=1,6)
00292         WRITE(3) (PARAM(I),I=1,6)
00293       ENDIF
00294       CLOSE(4)
00295 !
00296 !  2) READS THE GEOMETRY FILE
00297 !
00298 !  5 : 4 PARAMETERS
00299 !
00300       READ(2) NELEM,NPOIN2,ECKEN,NDUM
00301       WRITE(LU,*) '4 PARAMETERS IN GEOMETRY FILE'
00302       WRITE(LU,*) 'NELEM=',NELEM
00303       WRITE(LU,*) 'NPOIN2=',NPOIN2
00304       WRITE(LU,*) 'ECKEN=',ECKEN
00305       WRITE(LU,*) 'NDUM=',NDUM
00306 !
00307       IF(NPLAN.EQ.0) THEN
00308         WRITE(3) NELEM,NPOIN2,ECKEN,NDUM
00309       ELSE
00310         WRITE(3) NELEM*(NPLAN-1),NPOIN2*NPLAN,6,NDUM
00311       ENDIF
00312 !
00313 !  DYNAMICALLY ALLOCATES THE ARRAYS
00314 !
00315       ALLOCATE(NPOIN(NPROC),STAT=ERR)
00316       CALL CHECK_ALLOCATE(ERR, 'NPOIN')
00317       ALLOCATE(IKLESA(3,NELEM),STAT=ERR)
00318       CALL CHECK_ALLOCATE(ERR, 'IKLESA')
00319       ALLOCATE(IPOBO(NPOIN2)      ,STAT=ERR)
00320       CALL CHECK_ALLOCATE(ERR, 'IPOBO')
00321       IF(NPLAN.EQ.0) THEN
00322         ALLOCATE(VERIF(NPOIN2)    ,STAT=ERR)
00323       ELSE
00324         ALLOCATE(VERIF(NPOIN2*NPLAN)    ,STAT=ERR)
00325       ENDIF
00326       CALL CHECK_ALLOCATE(ERR, 'VERIF')
00327 !
00328 !     GLOBAL_VALUES IN SINGLE PRECISION, STORES NBV1 VALUES
00329 !
00330       IF(NPLAN.EQ.0) THEN
00331         ALLOCATE(GLOBAL_VALUE(NPOIN2,NBV1)       ,STAT=ERR)
00332       ELSE
00333         ALLOCATE(GLOBAL_VALUE(NPOIN2*NPLAN,NBV1) ,STAT=ERR)
00334       ENDIF
00335       CALL CHECK_ALLOCATE(ERR, 'GLOBAL_VALUE')
00336 !
00337 !     GLOBAL_VALUES IN DOUBLE PRECISION, STORES NBV1 VALUES
00338 !
00339       IF(SERAFIND_GEO.OR.SERAFIND_RES) THEN
00340         IF(NPLAN.EQ.0) THEN
00341           ALLOCATE(GLOBAL_VALUE_D(NPOIN2,NBV1)       ,STAT=ERR)
00342         ELSE
00343           ALLOCATE(GLOBAL_VALUE_D(NPOIN2*NPLAN,NBV1) ,STAT=ERR)
00344         ENDIF
00345         CALL CHECK_ALLOCATE(ERR, 'GLOBAL_VALUE_D')
00346       ENDIF
00347 !
00348 !     X AND Y SINGLE PRECISION
00349 !
00350       ALLOCATE(XORIG(NPOIN2)    ,STAT=ERR)
00351       CALL CHECK_ALLOCATE(ERR, 'XORIG')
00352       ALLOCATE(YORIG(NPOIN2)    ,STAT=ERR)
00353       CALL CHECK_ALLOCATE(ERR, 'YORIG')
00354 !
00355 !     X AND Y DOUBLE PRECISION
00356 !
00357       IF(SERAFIND_GEO.OR.SERAFIND_RES) THEN
00358         ALLOCATE(XORIG_D(NPOIN2)    ,STAT=ERR)
00359         CALL CHECK_ALLOCATE(ERR, 'XORIG_D')
00360         ALLOCATE(YORIG_D(NPOIN2)    ,STAT=ERR)
00361         CALL CHECK_ALLOCATE(ERR, 'YORIG_D')
00362       ENDIF
00363 !
00364 !  3D
00365 !
00366       IF(NPLAN.NE.0) THEN
00367       ALLOCATE(IKLE3D(NELEM*(NPLAN-1),6),STAT=ERR)
00368       CALL CHECK_ALLOCATE(ERR, 'IKLE3D')
00369       ALLOCATE(IPOBO3D(NPOIN2*NPLAN),STAT=ERR)
00370       CALL CHECK_ALLOCATE(ERR, 'IPOBO3D')
00371       ENDIF
00372 !
00373 !  END OF ALLOCATION ...
00374 !
00375 !  6 : IKLE
00376 !
00377       READ(2)  ((IKLESA(I,J),I=1,ECKEN),J=1,NELEM)
00378       WRITE(LU,*) 'WRITING IKLE'
00379       IF(NPLAN.EQ.0) THEN
00380         WRITE(3) ((IKLESA(I,J),I=1,ECKEN),J=1,NELEM)
00381       ELSE
00382 !       WRITES HERE IKLE3D (WITH INVERSION OF DIMENSIONS)
00383         CALL GRETEL_CPIKLE2
00384      &  (IKLE3D,IKLESA,NELEM,NELEM,NPOIN2,NPLAN)
00385         WRITE(3) ((IKLE3D(I,J),J=1,6),I=1,NELEM*(NPLAN-1))
00386       ENDIF
00387 !
00388 !  7 : IPOBO
00389 !
00390       READ(2)  (IPOBO(I),I=1,NPOIN2)
00391       WRITE(LU,*) 'WRITING IPOBO'
00392       IF(NPLAN.EQ.0) THEN
00393         WRITE(3) (IPOBO(I),I=1,NPOIN2)
00394       ELSE
00395 !       DUMMY VALUES
00396         DO I=1,NPOIN2*NPLAN
00397           IPOBO3D(I) = 0
00398         ENDDO
00399         WRITE(3) (IPOBO3D(I),I=1,NPOIN2*NPLAN)
00400       ENDIF
00401 !
00402 !  8 : X AND Y, WILL BE CHECKED LATER ...
00403 !
00404       IF(SERAFIND_GEO) THEN
00405         READ(2)  (XORIG_D(I),I=1,NPOIN2)
00406         READ(2)  (YORIG_D(I),I=1,NPOIN2)
00407         DO I=1,NPOIN2
00408           XORIG(I)=REAL(XORIG_D(I))
00409           YORIG(I)=REAL(YORIG_D(I))
00410         ENDDO
00411       ELSE
00412         READ(2)  (XORIG(I),I=1,NPOIN2)
00413         READ(2)  (YORIG(I),I=1,NPOIN2)
00414       ENDIF
00415 !
00416 !------------------------------------------------------------------------------
00417 !
00418 ! OPENS FILES AND READS/SKIPS HEADERS -> NPOIN(NPROC), NPOINMAX
00419 !
00420       DO IPID = 0,NPROC-1
00421         FU = IPID +10
00422         RESPAR=RES(1:I_LEN) // EXTENS(NPROC-1,IPID)
00423         OPEN (FU,FILE=RESPAR,FORM='UNFORMATTED',ERR=998)
00424         GO TO 999
00425 998     WRITE(LU,*) 'ERROR WHEN OPENING FILE: ',RESPAR,
00426      &                     ' USING FILE UNIT: ', FU
00427         CALL PLANTE(1)
00428         STOP
00429 999     REWIND(FU)
00430         CALL GRETEL_SKIP_HEADER(FU,NPOIN(IPID+1),NBV1,ERR,LU)
00431         IF(ERR.NE.0) THEN
00432           WRITE(LU,*) 'ERROR READING FILE '
00433           CALL PLANTE(1)
00434           STOP
00435         ENDIF
00436       ENDDO
00437 !
00438       NPOINMAX = MAXVAL(NPOIN)
00439 !
00440 !     ARRAY FOR LOCAL-GLOBAL NUMBERS, 2D-FIELD
00441 !
00442       IF(NPLAN.EQ.0) THEN
00443         ALLOCATE (KNOLG(NPOINMAX,NPROC),STAT=ERR)
00444       ELSE
00445         ALLOCATE (KNOLG(NPOINMAX/NPLAN,NPROC),STAT=ERR)
00446       ENDIF
00447       CALL CHECK_ALLOCATE(ERR, 'KNOLG')
00448 !
00449 !     LOCAL_VALUES IN SINGLE PRECISION, STORES NBV1 VALUES
00450 !
00451       ALLOCATE(LOCAL_VALUE(NPOINMAX,NBV1)    ,STAT=ERR)
00452       CALL CHECK_ALLOCATE(ERR, 'LOCAL_VALUE')
00453 !
00454 !     LOCAL_VALUES IN DOUBLE PRECISION, STORES NBV1 VALUES
00455 !
00456       IF(SERAFIND_GEO.OR.SERAFIND_RES) THEN
00457         ALLOCATE(LOCAL_VALUE_D(NPOINMAX,NBV1)    ,STAT=ERR)
00458         CALL CHECK_ALLOCATE(ERR, 'LOCAL_VALUE_D')
00459       ELSE
00460         ALLOCATE(LOCAL_VALUE_D(1,1)    ,STAT=ERR)
00461         CALL CHECK_ALLOCATE(ERR, 'LOCAL_VALUE_D')
00462       ENDIF
00463 !
00464 ! READS KNOLG(NPOIN,NPROC)
00465 !
00466       DO IPID = 0,NPROC-1
00467         FU = IPID +10
00468         IF(NPLAN.EQ.0) THEN
00469           READ(FU) (KNOLG(I,IPID+1),I=1,NPOIN(IPID+1))
00470         ELSE
00471           READ(FU) (KNOLG(I,IPID+1),I=1,NPOIN(IPID+1)/NPLAN)
00472         ENDIF
00473       ENDDO
00474 !
00475 ! READS LOCAL X
00476 !
00477       DO IPID = 0,NPROC-1
00478         FU = IPID +10
00479         IF(SERAFIND_RES) THEN
00480           READ(FU) (LOCAL_VALUE_D(I,1),I=1,NPOIN(IPID+1))
00481         ELSE
00482           READ(FU) (LOCAL_VALUE(I,1),I=1,NPOIN(IPID+1))
00483         ENDIF
00484         IF(NPLAN.EQ.0) THEN
00485           IF(SERAFIND_RES) THEN
00486             DO I=1,NPOIN(IPID+1)
00487               GLOBAL_VALUE_D(KNOLG(I,IPID+1),1)=LOCAL_VALUE_D(I,1)
00488               VERIF(KNOLG(I,IPID+1))   = 1
00489             ENDDO
00490           ELSE
00491             DO I=1,NPOIN(IPID+1)
00492               GLOBAL_VALUE(KNOLG(I,IPID+1),1)=LOCAL_VALUE(I,1)
00493               VERIF(KNOLG(I,IPID+1))   = 1
00494             ENDDO
00495           ENDIF
00496         ELSE
00497           NPOIN2LOC = NPOIN(IPID+1)/NPLAN
00498           IF(SERAFIND_RES) THEN
00499             DO I=1,NPOIN2LOC
00500             DO J=1,NPLAN
00501               GLOBAL_VALUE_D(KNOLG(I,IPID+1) + NPOIN2   *(J-1) , 1)=
00502      &        LOCAL_VALUE_D(      I         + NPOIN2LOC*(J-1) , 1)
00503               VERIF(KNOLG(I,IPID+1) + NPOIN2   *(J-1))  = 1
00504             ENDDO
00505             ENDDO
00506           ELSE
00507             DO I=1,NPOIN2LOC
00508             DO J=1,NPLAN
00509               GLOBAL_VALUE(KNOLG(I,IPID+1) + NPOIN2   *(J-1) , 1)=
00510      &        LOCAL_VALUE(      I         + NPOIN2LOC*(J-1) , 1)
00511               VERIF(KNOLG(I,IPID+1) + NPOIN2   *(J-1))  = 1
00512             ENDDO
00513             ENDDO
00514           ENDIF
00515         ENDIF
00516       ENDDO
00517 !
00518 ! COMPARISON WITH GLOBAL VALUES (ON SINGLE PRECISION VALUES)
00519 !
00520 !     IN 3D, CHECKS THE FIRST PLANE ONLY
00521 !
00522       IF(SERAFIND_RES) THEN
00523         DO I=1,NPOIN2
00524           IF(ABS(XORIG(I)-GLOBAL_VALUE_D(I,1)).GT.0.1) THEN
00525             WRITE(LU,*) 'POINT ',I,' XORIG=',XORIG(I),
00526      &                ' GLOBAL_VALUE=',GLOBAL_VALUE(I,1)
00527             WRITE(LU,*) 'GEO IS PROBABLY NOT THE RIGHT ORIGINAL FILE'
00528           ENDIF
00529         ENDDO
00530       ELSE
00531         DO I=1,NPOIN2
00532           IF(ABS(XORIG(I)-GLOBAL_VALUE(I,1)).GT.0.1) THEN
00533             WRITE(LU,*) 'POINT ',I,' XORIG=',XORIG(I),
00534      &                ' GLOBAL_VALUE=',GLOBAL_VALUE(I,1)
00535             WRITE(LU,*) 'GEO IS PROBABLY NOT THE RIGHT ORIGINAL FILE'
00536           ENDIF
00537         ENDDO
00538       ENDIF
00539 !
00540 ! FURTHER CHECKS
00541 !
00542       IF(NPLAN.EQ.0) THEN
00543         DO I=1,NPOIN2
00544           IF(VERIF(I).EQ.0) THEN
00545             WRITE(LU,*) 'ERROR, POINT I=',I,' FALSE FOR X-COORDINATES'
00546           ENDIF
00547         ENDDO
00548       ELSE
00549         DO I=1,NPOIN2*NPLAN
00550           IF(VERIF(I).EQ.0) THEN
00551             WRITE(LU,*) 'ERROR, POINT I=',I,' FALSE FOR X-COORDINATES'
00552           ENDIF
00553         ENDDO
00554       ENDIF
00555 !
00556 ! WRITES X
00557 !
00558       WRITE(LU,*) 'WRITING X-COORDINATES'
00559       IF(NPLAN.EQ.0) THEN
00560         IF(SERAFIND_RES) THEN
00561           WRITE(3) (GLOBAL_VALUE_D(I,1),I=1,NPOIN2)
00562         ELSE
00563           WRITE(3) (GLOBAL_VALUE(I,1),I=1,NPOIN2)
00564         ENDIF
00565       ELSE
00566         IF(SERAFIND_RES) THEN
00567           WRITE(3) (GLOBAL_VALUE_D(I,1),I=1,NPOIN2*NPLAN)
00568         ELSE
00569           WRITE(3) (GLOBAL_VALUE(I,1),I=1,NPOIN2*NPLAN)
00570         ENDIF
00571       ENDIF
00572 !
00573 ! READS LOCAL Y (EXACTLY LIKE READS LOCAL X, COULD BE A LOOP...)
00574 !
00575       DO IPID = 0,NPROC-1
00576         FU = IPID +10
00577         IF(SERAFIND_RES) THEN
00578           READ(FU) (LOCAL_VALUE_D(I,1),I=1,NPOIN(IPID+1))
00579         ELSE
00580           READ(FU) (LOCAL_VALUE(I,1),I=1,NPOIN(IPID+1))
00581         ENDIF
00582         IF(NPLAN.EQ.0) THEN
00583           IF(SERAFIND_RES) THEN
00584             DO I=1,NPOIN(IPID+1)
00585               GLOBAL_VALUE_D(KNOLG(I,IPID+1),1)=LOCAL_VALUE_D(I,1)
00586               VERIF(KNOLG(I,IPID+1))   = 1
00587             ENDDO
00588           ELSE
00589             DO I=1,NPOIN(IPID+1)
00590               GLOBAL_VALUE(KNOLG(I,IPID+1),1)=LOCAL_VALUE(I,1)
00591               VERIF(KNOLG(I,IPID+1))   = 1
00592             ENDDO
00593           ENDIF
00594         ELSE
00595           NPOIN2LOC = NPOIN(IPID+1)/NPLAN
00596           IF(SERAFIND_RES) THEN
00597             DO I=1,NPOIN2LOC
00598             DO J=1,NPLAN
00599               GLOBAL_VALUE_D(KNOLG(I,IPID+1) + NPOIN2   *(J-1) , 1)=
00600      &        LOCAL_VALUE_D(      I         + NPOIN2LOC*(J-1) , 1)
00601               VERIF(KNOLG(I,IPID+1) + NPOIN2   *(J-1))  = 1
00602             ENDDO
00603             ENDDO
00604           ELSE
00605             DO I=1,NPOIN2LOC
00606             DO J=1,NPLAN
00607               GLOBAL_VALUE(KNOLG(I,IPID+1) + NPOIN2   *(J-1) , 1)=
00608      &        LOCAL_VALUE(      I         + NPOIN2LOC*(J-1) , 1)
00609               VERIF(KNOLG(I,IPID+1) + NPOIN2   *(J-1))  = 1
00610             ENDDO
00611             ENDDO
00612           ENDIF
00613         ENDIF
00614       ENDDO
00615 !
00616 ! COMPARISON WITH GLOBAL VALUES
00617 !
00618 ! IN 3D, CHECKS THE FIRST PLANE ONLY
00619 !
00620       IF(SERAFIND_RES) THEN
00621         DO I=1,NPOIN2
00622           IF(ABS(YORIG(I)-GLOBAL_VALUE_D(I,1)).GT.0.1) THEN
00623             WRITE(LU,*) 'POINT ',I,' YORIG=',YORIG(I),
00624      &                      ' GLOBAL_VALUE=',GLOBAL_VALUE(I,1)
00625             WRITE(LU,*) 'GEO IS PROBABLY NOT THE RIGHT ORIGINAL FILE'
00626           ENDIF
00627         ENDDO
00628       ELSE
00629         DO I=1,NPOIN2
00630           IF(ABS(YORIG(I)-GLOBAL_VALUE(I,1)).GT.0.1) THEN
00631             WRITE(LU,*) 'POINT ',I,' YORIG=',YORIG(I),
00632      &                      ' GLOBAL_VALUE=',GLOBAL_VALUE(I,1)
00633             WRITE(LU,*) 'GEO IS PROBABLY NOT THE RIGHT ORIGINAL FILE'
00634           ENDIF
00635         ENDDO
00636       ENDIF
00637 !
00638 ! FURTHER CHECKS
00639 !
00640       IF(NPLAN.EQ.0) THEN
00641         DO I=1,NPOIN2
00642           IF(VERIF(I).EQ.0) THEN
00643             WRITE(LU,*) 'ERROR, POINT I=',I,' FALSE FOR Y-COORDINATES'
00644           ENDIF
00645         ENDDO
00646       ELSE
00647         DO I=1,NPOIN2*NPLAN
00648           IF(VERIF(I).EQ.0) THEN
00649             WRITE(LU,*) 'ERROR, POINT I=',I,' FALSE FOR Y-COORDINATES'
00650           ENDIF
00651         ENDDO
00652       ENDIF
00653 !
00654 ! WRITES Y
00655 !
00656       WRITE(LU,*) 'WRITING Y-COORDINATES'
00657       IF(NPLAN.EQ.0) THEN
00658         IF(SERAFIND_RES) THEN
00659           WRITE(3) (GLOBAL_VALUE_D(I,1),I=1,NPOIN2)
00660         ELSE
00661           WRITE(3) (GLOBAL_VALUE(I,1),I=1,NPOIN2)
00662         ENDIF
00663       ELSE
00664         IF(SERAFIND_RES) THEN
00665           WRITE(3) (GLOBAL_VALUE_D(I,1),I=1,NPOIN2*NPLAN)
00666         ELSE
00667           WRITE(3) (GLOBAL_VALUE(I,1),I=1,NPOIN2*NPLAN)
00668         ENDIF
00669       ENDIF
00670 !
00671 ! READS DATASETS
00672 !
00673       NRESU = 0
00674 !
00675 2000  NRESU = NRESU + 1
00676 !
00677       IF(NPLAN.EQ.0) THEN
00678         DO I=1,NPOIN2
00679           VERIF(I)=0
00680         ENDDO
00681       ELSE
00682         DO I=1,NPOIN2*NPLAN
00683           VERIF(I)=0
00684         ENDDO
00685       ENDIF
00686 !
00687       WRITE(LU,*) 'TRY TO READ DATASET NO.',NRESU
00688 !
00689       DO IPID = 0,NPROC-1
00690         FU = IPID +10
00691         CALL GRETEL_READ_DATASET(LOCAL_VALUE,LOCAL_VALUE_D,
00692      &                           SERAFIND_RES,
00693      &                           NPOINMAX,NPOIN(IPID+1),
00694      &                           NBV1,AT,AT_D,FU,ENDE)
00695         IF(ENDE) GOTO 3000
00696 !
00697 !       STORES EACH DATASET
00698 !
00699         IF(NPLAN.EQ.0) THEN
00700           IF(SERAFIND_RES) THEN
00701             DO I=1,NPOIN(IPID+1)
00702             DO K=1,NBV1
00703               GLOBAL_VALUE_D(KNOLG(I,IPID+1),K)=LOCAL_VALUE_D(I,K)
00704             ENDDO
00705             VERIF(KNOLG(I,IPID+1)) = 1
00706             ENDDO
00707           ELSE
00708             DO I=1,NPOIN(IPID+1)
00709             DO K=1,NBV1
00710               GLOBAL_VALUE(KNOLG(I,IPID+1),K) = LOCAL_VALUE(I,K)
00711             ENDDO
00712             VERIF(KNOLG(I,IPID+1)) = 1
00713             ENDDO
00714           ENDIF
00715         ELSE
00716           NPOIN2LOC = NPOIN(IPID+1)/NPLAN
00717           IF(SERAFIND_RES) THEN
00718             DO I=1,NPOIN2LOC
00719               DO J=1,NPLAN
00720                 DO K=1,NBV1
00721             GLOBAL_VALUE_D(KNOLG(I,IPID+1)+NPOIN2   *(J-1),K)=
00722      &       LOCAL_VALUE_D(      I        +NPOIN2LOC*(J-1),K)
00723                 ENDDO
00724             VERIF(KNOLG(I,IPID+1) + NPOIN2*(J-1)) = 1
00725               ENDDO
00726             ENDDO
00727           ELSE
00728             DO I=1,NPOIN2LOC
00729               DO J=1,NPLAN
00730                 DO K=1,NBV1
00731             GLOBAL_VALUE(KNOLG(I,IPID+1)+NPOIN2   *(J-1),K)=
00732      &       LOCAL_VALUE(      I        +NPOIN2LOC*(J-1),K)
00733                 ENDDO
00734             VERIF(KNOLG(I,IPID+1) + NPOIN2*(J-1)) = 1
00735               ENDDO
00736             ENDDO
00737           ENDIF
00738         ENDIF
00739       ENDDO
00740 !
00741 ! WRITES GLOBAL DATASET
00742 !
00743       WRITE(LU,*)'WRITING DATASET NO.',NRESU,' TIME =',AT
00744 !
00745 !     TIME
00746 !
00747       IF(SERAFIND_RES) THEN
00748         WRITE(3) AT_D
00749       ELSE
00750         WRITE(3) AT
00751       ENDIF
00752 !
00753 !     VARIABLES
00754 !
00755       DO K = 1,NBV1
00756         IF(NPLAN.EQ.0) THEN
00757           IF(SERAFIND_RES) THEN
00758             WRITE(3) (GLOBAL_VALUE_D(I,K),I=1,NPOIN2)
00759           ELSE
00760             WRITE(3) (GLOBAL_VALUE(I,K),I=1,NPOIN2)
00761           ENDIF
00762         ELSE
00763           IF(SERAFIND_RES) THEN
00764             WRITE(3) (GLOBAL_VALUE_D(I,K),I=1,NPOIN2*NPLAN)
00765           ELSE
00766             WRITE(3) (GLOBAL_VALUE(I,K),I=1,NPOIN2*NPLAN)
00767           ENDIF
00768         ENDIF
00769       ENDDO
00770 !
00771 ! CHECKS ...
00772 !
00773       IF(NPLAN.EQ.0) THEN
00774         DO I=1,NPOIN2
00775           IF(VERIF(I).EQ.0) THEN
00776             WRITE(LU,*) 'ERROR, POINT I=',I,' FALSE FOR NRESU=',NRESU
00777           ENDIF
00778         ENDDO
00779       ELSE
00780         DO I=1,NPOIN2*NPLAN
00781           IF(VERIF(I).EQ.0) THEN
00782             WRITE(LU,*) 'ERROR, POINT I=',I,' FALSE FOR NRESU=',NRESU
00783           ENDIF
00784         ENDDO
00785       ENDIF
00786 !
00787       GO TO 2000
00788 !
00789 3000  WRITE(LU,*) 'END OF PROGRAM, ',NRESU-1,' DATASETS FOUND'
00790 !
00791       CLOSE(2)
00792       CLOSE(3)
00793       DO IPID = 0,NPROC-1
00794         FU = IPID +10
00795         CLOSE (FU)
00796       ENDDO
00797 !
00798 !|==================================================================|
00799 !|                                                                  |
00800 !| END: MERGES FILES RESULTING FROM THE DOMAIN DECOMPOSITION        |
00801 !|                                                                  |
00802 !|==================================================================|
00803 !
00804 !
00805       STOP 0
00806       END PROGRAM GRETEL_AUTOP

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