gredelpts_autop.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\gretel\gredelpts_autop.f
00002 !
00058                      PROGRAM GREDELPTS_AUTOP
00059 !                    ***********************
00060 !
00061 !
00062 !***********************************************************************
00063 ! PARALLEL   V6P2                                   21/08/2010
00064 !***********************************************************************
00065 !
00066 !
00067 !
00068 !
00069 !
00070 !
00071 !
00072 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00073 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00074 !
00075       IMPLICIT NONE
00076       INTEGER LNG,LU
00077       INTEGER LI
00078       COMMON/INFO/LNG,LU
00079 !
00080       CHARACTER(LEN=30) GEO
00081 !
00082       INTEGER IPID,ERR,FU
00083       INTEGER NELEM,ECKEN,NDUM,I,J,NBV1,NBV2,PARAM(10)
00084       INTEGER NPLAN,NPOIN2,NPOIN2LOC,NPLANLOC
00085       INTEGER NPROC,NRESU,NPOINMAX
00086       INTEGER I_S, I_SP, I_LEN
00087       INTEGER IT
00088 !
00089       INTEGER, DIMENSION(:)  , ALLOCATABLE :: NPOIN,VERIF
00090       INTEGER, DIMENSION(:,:), ALLOCATABLE :: KNOLG
00091 !
00092 !
00093       REAL   , DIMENSION(:)  , ALLOCATABLE :: GLOBAL_VALUE
00094       REAL   , DIMENSION(:)  , ALLOCATABLE :: LOCAL_VALUE
00095 !
00096       LOGICAL IS,ENDE
00097 !
00098       CHARACTER*30 RES
00099       CHARACTER*50 RESPAR
00100       CHARACTER*11 EXTENS
00101       EXTERNAL    EXTENS
00102       INTRINSIC MAXVAL
00103 !
00104 !-------------------------------------------------------------------------
00105 !
00106       LI=5
00107       LU=6
00108       LNG=2
00109 !HW
00110 !JAJ INTRODUCE YOURSELF WITH THE RELEASE DATE
00111 !
00112       WRITE(LU,*) 'I AM GREDELPTS, COUSIN OF GRETEL FROM BAW HAMBURG'
00113       WRITE(LU,*)
00114 !
00115 ! READS FILENAMES AND THE NUMBER OF PROCESSORS / PARTITIONS
00116 !
00117       WRITE (LU, ADVANCE='NO',
00118      &    FMT='(/,'' GLOBAL GEOMETRY FILE: '')')
00119 !      REWIND(LI)
00120       READ(LI,*) GEO
00121       WRITE(LU,*) GEO
00122 !
00123       WRITE (LU, ADVANCE='NO', FMT='(/,'' RESULT FILE: '')')
00124       READ(LI,*) RES
00125       WRITE(LU,*) RES
00126 !
00127       WRITE (LU,ADVANCE='NO',FMT='(/,'' NUMBER OF PROCESSORS: '')')
00128       READ (LI,*) NPROC
00129       WRITE(LU,*) NPROC
00130 !
00131       INQUIRE (FILE=GEO,EXIST=IS)
00132       IF (.NOT.IS) THEN
00133         WRITE (LU,*) 'FILE DOES NOT EXIST: ', GEO
00134         CALL PLANTE(1)
00135         STOP
00136       END IF
00137 !
00138       I_S  = LEN (RES)
00139       I_SP = I_S + 1
00140       DO I=1,I_S
00141         IF(RES(I_SP-I:I_SP-I) .NE. ' ') EXIT
00142       ENDDO
00143       I_LEN=I_SP - I
00144 !
00145 !     GEOMETRY FILE, READ UNTIL 10 PARAMETERS:
00146 !
00147       OPEN(2,FILE=GEO,FORM='UNFORMATTED',STATUS='OLD',ERR=990)
00148       READ(2,ERR=990)
00149       READ(2,ERR=990) NBV1,NBV2
00150       DO I=1,NBV1+NBV2
00151         READ(2,ERR=990)
00152       ENDDO ! I
00153       GO TO 992
00154 990   WRITE(LU,*) 'ERROR WHEN OPENING OR READING FILE: ',GEO
00155       CALL PLANTE(1)
00156       STOP
00157 992   CONTINUE
00158 !     READS THE 10 PARAMETERS AND THE DATE
00159       READ(2) (PARAM(I),I=1,10)
00160       IF(PARAM(10).EQ.1) READ(2) (PARAM(I),I=1,6)
00161 !
00162 !     RESULTS FILE:
00163 !
00164       OPEN(3,FILE=RES,FORM='UNFORMATTED',ERR=991)
00165       GO TO 993
00166 991   WRITE(LU,*) 'ERROR WHEN OPENING FILE: ',RES
00167       CALL PLANTE(1)
00168       STOP
00169 993   CONTINUE
00170 !
00171 !     1) READS THE BEGINNING OF THE FIRST RESULTS FILE
00172 !
00173 !CC      RESPAR=RES // EXTENS(2**IDIMS-1,0)
00174 !
00175       RESPAR=RES(1:I_LEN) // EXTENS(NPROC-1,0)
00176 !
00177       INQUIRE (FILE=RESPAR,EXIST=IS)
00178       IF (.NOT.IS) THEN
00179         WRITE (LU,*) 'FILE DOES NOT EXIST: ', RESPAR
00180         WRITE (LU,*) 'CHECK THE NUMBER OF PROCESSORS'
00181         WRITE (LU,*) 'AND THE RESULT FILE CORE NAME'
00182         CALL PLANTE(1)
00183         STOP
00184       END IF
00185 !
00186       OPEN(4,FILE=RESPAR,FORM='UNFORMATTED',ERR=994)
00187       GO TO 995
00188 994   WRITE(LU,*) 'ERROR WHEN OPENING FILE: ',RESPAR
00189       CALL PLANTE(1)
00190       STOP
00191 995   CONTINUE
00192 !
00193       READ(4) NPOIN2
00194       READ(4) NPLAN
00195       IF(NPLAN.EQ.1) NPLAN = 0
00196 !
00197       CLOSE(4)
00198 !
00199 !  5 : 4 PARAMETERS
00200 !
00201       READ(2) NELEM,NPOIN2,ECKEN,NDUM
00202       WRITE(LU,*) '4 PARAMETERS IN GEOMETRY FILE'
00203       WRITE(LU,*) 'NELEM=',  NELEM
00204       WRITE(LU,*) 'NPOIN2=', NPOIN2
00205       WRITE(LU,*) 'ECKEN=',  ECKEN
00206       WRITE(LU,*) 'NDUM=',   NDUM
00207 !
00208 !  DYNAMICALLY ALLOCATES THE ARRAYS
00209 !
00210       ALLOCATE(NPOIN(NPROC),STAT=ERR)
00211       CALL CHECK_ALLOCATE(ERR, 'NPOIN')
00212       IF(NPLAN.EQ.0) THEN
00213         ALLOCATE(VERIF(NPOIN2)    ,STAT=ERR)
00214       ELSE
00215         ALLOCATE(VERIF(NPOIN2*NPLAN)    ,STAT=ERR)
00216       ENDIF
00217       CALL CHECK_ALLOCATE(ERR, 'VERIF')
00218 !  GLOBAL_VALUES, STORES THE WHOLE DATASET (NBV1-VALUES)
00219       IF(NPLAN.EQ.0) THEN
00220         ALLOCATE(GLOBAL_VALUE(NPOIN2)       ,STAT=ERR)
00221       ELSE
00222         ALLOCATE(GLOBAL_VALUE(NPOIN2*NPLAN) ,STAT=ERR)
00223       ENDIF
00224       CALL CHECK_ALLOCATE(ERR, 'GLOBAL_VALUE')
00225 !
00226 !  END OF ALLOCATION ...
00227 !
00228 !------------------------------------------------------------------------------
00229 !
00230 ! OPENS FILES AND READS/SKIPS HEADERS -> NPOIN(NPROC), NPOINMAX
00231 !
00232       DO IPID = 0,NPROC-1
00233         FU = IPID +10
00234         RESPAR=RES(1:I_LEN) // EXTENS(NPROC-1,IPID)
00235         OPEN (FU,FILE=RESPAR,FORM='UNFORMATTED',ERR=998)
00236         GO TO 999
00237 998     WRITE(LU,*) 'ERROR WHEN OPENING FILE: ',RESPAR,
00238      &                     ' USING FILE UNIT: ', FU
00239         CALL PLANTE(1)
00240         STOP
00241 999     REWIND(FU)
00242         READ(FU) NPOIN(IPID+1)
00243         READ(FU) NPLANLOC
00244       END DO
00245 !
00246       NPOINMAX = MAXVAL(NPOIN)
00247 ! ARRAY FOR LOCAL-GLOBAL NUMBERS, 2D-FIELD
00248       IF(NPLAN.EQ.0) THEN
00249         ALLOCATE (KNOLG(NPOINMAX,NPROC),STAT=ERR)
00250       ELSE
00251         ALLOCATE (KNOLG(NPOINMAX/NPLAN,NPROC),STAT=ERR)
00252       ENDIF
00253       CALL CHECK_ALLOCATE(ERR, 'KNOLG')
00254 !  LOCAL_VALUES, STORES THE WHOLE DATASET (NBV1-VALUES)
00255       ALLOCATE(LOCAL_VALUE(NPOINMAX),STAT=ERR)
00256       CALL CHECK_ALLOCATE(ERR, 'LOCAL_VALUE')
00257 !
00258 ! READS KNOLG(NPOIN,NPROC)
00259 !
00260       DO IPID = 0,NPROC-1
00261         FU = IPID +10
00262         IF(NPLAN.EQ.0) THEN
00263           READ(FU) (KNOLG(I,IPID+1),I=1,NPOIN(IPID+1))
00264         ELSE
00265           READ(FU) (KNOLG(I,IPID+1),I=1,NPOIN(IPID+1)/NPLAN)
00266         ENDIF
00267       END DO
00268 !
00269 ! READS DATASETS
00270 !
00271       NRESU = 0
00272 !
00273 2000  NRESU = NRESU + 1
00274 !
00275       IF(NPLAN.EQ.0) THEN
00276         DO I=1,NPOIN2
00277           VERIF(I)=0
00278         ENDDO
00279       ELSE
00280         DO I=1,NPOIN2*NPLAN
00281           VERIF(I)=0
00282         ENDDO
00283       ENDIF
00284 !
00285       WRITE(LU,*)'TRY TO READ DATASET NO.',NRESU
00286 !
00287       DO IPID = 0,NPROC-1
00288         FU = IPID +10
00289         CALL GREDELPTS_READ_DATASET
00290      &  (LOCAL_VALUE,NPOINMAX,NPOIN(IPID+1),IT,FU,ENDE)
00291         IF (ENDE) GOTO 3000
00292 ! STORES EACH DATASET
00293         IF(NPLAN.EQ.0) THEN
00294           DO I=1,NPOIN(IPID+1)
00295             GLOBAL_VALUE(KNOLG(I,IPID+1)) = LOCAL_VALUE(I)
00296             VERIF(KNOLG(I,IPID+1))   = 1
00297           END DO
00298         ELSE
00299           NPOIN2LOC = NPOIN(IPID+1)/NPLAN
00300           DO I=1,NPOIN2LOC
00301           DO J=1,NPLAN
00302           GLOBAL_VALUE(KNOLG(I,IPID+1) + NPOIN2   *(J-1)) =
00303      &     LOCAL_VALUE(      I         + NPOIN2LOC*(J-1))
00304           VERIF(KNOLG(I,IPID+1) + NPOIN2   *(J-1)) = 1
00305           END DO
00306           END DO
00307         ENDIF
00308       END DO
00309 ! WRITES GLOBAL DATASET
00310       WRITE(LU,*)'WRITING DATASET NO.',NRESU,' TIME =',IT
00311 !
00312       IF(NPLAN.EQ.0) THEN
00313         WRITE(3) IT, (GLOBAL_VALUE(I),I=1,NPOIN2)
00314       ELSE
00315         WRITE(3) IT, (GLOBAL_VALUE(I),I=1,NPOIN2*NPLAN)
00316       ENDIF
00317 ! CHECKS ...
00318       IF(NPLAN.EQ.0) THEN
00319         DO I=1,NPOIN2
00320           IF(VERIF(I).EQ.0) THEN
00321             WRITE(LU,*) 'ERROR, POINT I=',I,' FALSE FOR NRESU=',NRESU
00322           ENDIF
00323         END DO
00324       ELSE
00325         DO I=1,NPOIN2*NPLAN
00326           IF(VERIF(I).EQ.0) THEN
00327             WRITE(LU,*) 'ERROR, POINT I=',I,' FALSE FOR NRESU=',NRESU
00328           ENDIF
00329         END DO
00330       ENDIF
00331 !
00332       GO TO 2000
00333 !
00334 3000  WRITE(LU,*) 'END OF PROGRAM, ',NRESU-1,' DATASETS FOUND'
00335 !
00336       CLOSE(2)
00337       CLOSE(3)
00338 !
00339       DO IPID = 0,NPROC-1
00340         FU = IPID +10
00341         CLOSE (FU)
00342       END DO
00343 !
00344       STOP 0
00345       END PROGRAM GREDELPTS_AUTOP

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