gredelpts_autop.f

Go to the documentation of this file.

!                   ***********************
                    PROGRAM gredelpts_autop
!                   ***********************
!
!
!***********************************************************************
! PARALLEL   V6P2                                   21/08/2010
!***********************************************************************
!
!brief    MERGES THE RESULTS OF A PARALLEL COMPUTATION (COUPLING
!+                WITH DELWAQ) TO WRITE A SINGLE FILE IN DELWAQ FORMAT.
!
!history  JAJ
!+        2001/2
!+
!+   SLIGHTLY CHANGED TO DEAL WITH:
!
!history  HW, BAW-HAMBURG
!+        20/02/2003
!+
!+   IMPROVED READING OF DATASETS
!
!history  JAJ
!+        14/03/2003
!+
!+   ADDED EXIT CODES
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      IMPLICIT NONE
!
      CHARACTER(LEN=30) GEO
!
      INTEGER IPID,ERR,FU
      INTEGER NELEM,ECKEN,NDUM,I,J,NBV1,NBV2,PARAM(10)
      INTEGER NPLAN,NPOIN2,NPOIN2LOC,NPLANLOC
      INTEGER NPROC,NRESU,NPOINMAX
      INTEGER I_S, I_SP, I_LEN
      INTEGER IT
!
      INTEGER, DIMENSION(:)  , ALLOCATABLE :: NPOIN,VERIF
      INTEGER, DIMENSION(:,:), ALLOCATABLE :: KNOLG
!
!
      REAL   , DIMENSION(:)  , ALLOCATABLE :: GLOBAL_VALUE
      REAL   , DIMENSION(:)  , ALLOCATABLE :: LOCAL_VALUE
!
      LOGICAL IS,ENDE
!
      CHARACTER(LEN=30) RES
      CHARACTER(LEN=50) RESPAR
      CHARACTER(LEN=11) EXTENS
      EXTERNAL    extens
      INTRINSIC maxval
!
!-------------------------------------------------------------------------
!
      li=5
      lu=6
      lng=2
!HW
!JAJ INTRODUCE YOURSELF WITH THE RELEASE DATE
!
      WRITE(lu,*) 'I AM GREDELPTS, COUSIN OF GRETEL FROM BAW HAMBURG'
      WRITE(lu,*)
!
! READS FILENAMES AND THE NUMBER OF PROCESSORS / PARTITIONS
!
      WRITE (lu, advance='NO',
     &    fmt='(/,'' GLOBAL GEOMETRY FILE: '')')
!      REWIND(LI)
      READ(li,*) geo
      WRITE(lu,*) geo
!
      WRITE (lu, advance='NO', fmt='(/,'' RESULT FILE: '')')
      READ(li,*) res
      WRITE(lu,*) res
!
      WRITE (lu,advance='NO',fmt='(/,'' NUMBER OF PROCESSORS: '')')
      READ (li,*) nproc
      WRITE(lu,*) nproc
!
      INQUIRE (file=geo,exist=is)
      IF (.NOT.is) THEN
        WRITE (lu,*) 'FILE DOES NOT EXIST: ', geo
        CALL plante(1)
        stop
      END IF
!
      i_s  = len(res)
      i_sp = i_s + 1
      DO i=1,i_s
        IF(res(i_sp-i:i_sp-i) .NE. ' ') EXIT
      ENDDO
      i_len=i_sp - i
!
!     GEOMETRY FILE, READ UNTIL 10 PARAMETERS:
!
      OPEN(2,file=geo,form='UNFORMATTED',status='OLD',err=990)
      READ(2,err=990)
      READ(2,err=990) nbv1,nbv2
      DO i=1,nbv1+nbv2
        READ(2,err=990)
      ENDDO ! I
      GO TO 992
990   WRITE(lu,*) 'ERROR WHEN OPENING OR READING FILE: ',geo
      CALL plante(1)
      stop
992   CONTINUE
!     READS THE 10 PARAMETERS AND THE DATE
      READ(2) (param(i),i=1,10)
      IF(param(10).EQ.1) READ(2) (param(i),i=1,6)
!
!     RESULTS FILE:
!
      OPEN(3,file=res,form='UNFORMATTED',err=991)
      GO TO 993
991   WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',res
      CALL plante(1)
      stop
993   CONTINUE
!
!     1) READS THE BEGINNING OF THE FIRST RESULTS FILE
!
!CC      RESPAR=RES // EXTENS(2**IDIMS-1,0)
!
      respar=res(1:i_len) // extens(nproc-1,0)
!
      INQUIRE (file=respar,exist=is)
      IF (.NOT.is) THEN
        WRITE (lu,*) 'FILE DOES NOT EXIST: ', respar
        WRITE (lu,*) 'CHECK THE NUMBER OF PROCESSORS'
        WRITE (lu,*) 'AND THE RESULT FILE CORE NAME'
        CALL plante(1)
        stop
      END IF
!
      OPEN(4,file=respar,form='UNFORMATTED',err=994)
      GO TO 995
994   WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',respar
      CALL plante(1)
      stop
995   CONTINUE
!
      READ(4) npoin2
      READ(4) nplan
      IF(nplan.EQ.1) nplan = 0
!
      CLOSE(4)
!
!  5 : 4 PARAMETERS
!
      READ(2) nelem,npoin2,ecken,ndum
      WRITE(lu,*) '4 PARAMETERS IN GEOMETRY FILE'
      WRITE(lu,*) 'NELEM=',  nelem
      WRITE(lu,*) 'NPOIN2=', npoin2
      WRITE(lu,*) 'ECKEN=',  ecken
      WRITE(lu,*) 'NDUM=',   ndum
!
!  DYNAMICALLY ALLOCATES THE ARRAYS
!
      ALLOCATE(npoin(nproc),stat=err)
      CALL check_allocate(err, 'NPOIN')
      IF(nplan.EQ.0) THEN
        ALLOCATE(verif(npoin2)    ,stat=err)
      ELSE
        ALLOCATE(verif(npoin2*nplan)    ,stat=err)
      ENDIF
      CALL check_allocate(err, 'VERIF')
!  GLOBAL_VALUES, STORES THE WHOLE DATASET (NBV1-VALUES)
      IF(nplan.EQ.0) THEN
        ALLOCATE(global_value(npoin2)       ,stat=err)
      ELSE
        ALLOCATE(global_value(npoin2*nplan) ,stat=err)
      ENDIF
      CALL check_allocate(err, 'GLOBAL_VALUE')
!
!  END OF ALLOCATION ...
!
!------------------------------------------------------------------------------
!
! OPENS FILES AND READS/SKIPS HEADERS -> NPOIN(NPROC), NPOINMAX
!
      DO ipid = 0,nproc-1
        fu = ipid +10
        respar=res(1:i_len) // extens(nproc-1,ipid)
        OPEN (fu,file=respar,form='UNFORMATTED',err=998)
        GO TO 999
998     WRITE(lu,*) 'ERROR WHEN OPENING FILE: ',respar,
     &                     ' USING FILE UNIT: ', fu
        CALL plante(1)
        stop
999     rewind(fu)
        READ(fu) npoin(ipid+1)
        READ(fu) nplanloc
      END DO
!
      npoinmax = maxval(npoin)
! ARRAY FOR LOCAL-GLOBAL NUMBERS, 2D-FIELD
      IF(nplan.EQ.0) THEN
        ALLOCATE (knolg(npoinmax,nproc),stat=err)
      ELSE
        ALLOCATE (knolg(npoinmax/nplan,nproc),stat=err)
      ENDIF
      CALL check_allocate(err, 'KNOLG')
!  LOCAL_VALUES, STORES THE WHOLE DATASET (NBV1-VALUES)
      ALLOCATE(local_value(npoinmax),stat=err)
      CALL check_allocate(err, 'LOCAL_VALUE')
!
! READS KNOLG(NPOIN,NPROC)
!
      DO ipid = 0,nproc-1
        fu = ipid +10
        IF(nplan.EQ.0) THEN
          READ(fu) (knolg(i,ipid+1),i=1,npoin(ipid+1))
        ELSE
          READ(fu) (knolg(i,ipid+1),i=1,npoin(ipid+1)/nplan)
        ENDIF
      END DO
!
! READS DATASETS
!
      nresu = 0
!
2000  nresu = nresu + 1
!
      IF(nplan.EQ.0) THEN
        DO i=1,npoin2
          verif(i)=0
        ENDDO
      ELSE
        DO i=1,npoin2*nplan
          verif(i)=0
        ENDDO
      ENDIF
!
      WRITE(lu,*)'TRY TO READ DATASET NO.',nresu
!
      DO ipid = 0,nproc-1
        fu = ipid +10
        CALL gredelpts_read_dataset
     &  (local_value,npoinmax,npoin(ipid+1),it,fu,ende)
        IF (ende) GOTO 3000
! STORES EACH DATASET
        IF(nplan.EQ.0) THEN
          DO i=1,npoin(ipid+1)
            global_value(knolg(i,ipid+1)) = local_value(i)
            verif(knolg(i,ipid+1))   = 1
          END DO
        ELSE
          npoin2loc = npoin(ipid+1)/nplan
          DO i=1,npoin2loc
          DO j=1,nplan
          global_value(knolg(i,ipid+1) + npoin2   *(j-1)) =
     &     local_value(      i         + npoin2loc*(j-1))
          verif(knolg(i,ipid+1) + npoin2   *(j-1)) = 1
          END DO
          END DO
        ENDIF
      END DO
! WRITES GLOBAL DATASET
      WRITE(lu,*)'WRITING DATASET NO.',nresu,' TIME =',it
!
      IF(nplan.EQ.0) THEN
        WRITE(3) it, (global_value(i),i=1,npoin2)
      ELSE
        WRITE(3) it, (global_value(i),i=1,npoin2*nplan)
      ENDIF
! CHECKS ...
      IF(nplan.EQ.0) THEN
        DO i=1,npoin2
          IF(verif(i).EQ.0) THEN
            WRITE(lu,*) 'ERROR, POINT I=',i,' FALSE FOR NRESU=',nresu
          ENDIF
        END DO
      ELSE
        DO i=1,npoin2*nplan
          IF(verif(i).EQ.0) THEN
            WRITE(lu,*) 'ERROR, POINT I=',i,' FALSE FOR NRESU=',nresu
          ENDIF
        END DO
      ENDIF
!
      GO TO 2000
!
3000  WRITE(lu,*) 'END OF PROGRAM, ',nresu-1,' DATASETS FOUND'
!
      CLOSE(2)
      CLOSE(3)
!
      DO ipid = 0,nproc-1
        fu = ipid +10
        CLOSE (fu)
      END DO
!
      stop 0
      END PROGRAM gredelpts_autop