p_init.F

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE p_init
!                   *****************
!
     &(chaine,ncar,ipid,ncsize)
!
!***********************************************************************
! PARALLEL   V6P3                                   21/08/2010
!***********************************************************************
!
!brief    INITIALISES.
!+                REGISTERS PROGRAM WITH PARASTATION.
!
!history  HANS HERRMANN (HANOVER)
!+        **/06/1996
!+
!+
!
!history  REINHARD HINKELMANN (HANOVER)
!+        08/06/1996
!+
!+   MODIFIED
!
!history  J-M HERVOUET (LNH)
!+        17/12/1996
!+
!+   MODIFIED
!
!history  RAINER JOHANNI (SGI MUNICH)
!+        **/10/1999
!+
!+   ADAPTED FOR MPI
!
!history  J.A. JANKOWSKI (BAW KARLSRUHE)
!+        28/12/1999
!+
!+   RELEASE 5.0 MODIFIED
!
!history  P. VEZOLLE (IBM)
!+        16/05/2008
!+        V5P9
!+   MODIFIED (SIZE OF EXTENSION)
!
!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
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| CHAINE         |---| WORKING DIRECTORY
!| IPID           |---| PROCESSUS ID
!| NCAR           |---| SIZE OF THE CHARACTER STRING
!| NCSIZE         |---| NUMBER OF MPI PROCESSUS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_parallel
      USE declarations_special
      IMPLICIT NONE
!
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(OUT)            :: NCAR,IPID,NCSIZE
      CHARACTER(LEN=MAXLENTMPDIR), INTENT(OUT) :: CHAINE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
#if defined HAVE_MPI
      INTEGER IER,NPREAD
!
      CHARACTER(LEN=MAXLENTMPDIR+5) EXE
!
      LOGICAL YAPARA,INIT
      INTEGER :: ID
      CHARACTER(LEN=11) PNUMBER
      CHARACTER(LEN=13) MYNAM
!
!-----------------------------------------------------------------------
! MPI IS SILENT WHEN EVERYTHING IS GOING ON PROPERLY
! DEFAULT LANGUAGE 2 AND STANDARD OUTPUT 6
! IN ORDER TO SEE ERROR MESSAGES (TO THE MASTER!)
! THE SUBROUTINE CALLED NEXT IS READ_CONFIG !
! THIS IS NOT PRETTY...
!
      ncar = 0
      chaine =' '
      ipid=0
      ncsize=0
!
      lng=2
!
! INITIALISES MPI
!
      init = .false.
      CALL mpi_initialized(init,ier)
      IF(.NOT.init) THEN
#  ifdef COMPAD
        CALL ampi_init(ier)
#  else
        CALL mpi_init(ier)
#  endif
        IF(ier.NE.0) THEN
          WRITE(lu,*) 'P_INIT: ERROR IN MPI_INIT'
          WRITE(lu,*) 'MPI ERROR ',ier
          CALL plante(1)
          stop
        ENDIF
      ENDIF
!
! OBTAINS IPID, IT IS VIRTUALLY THE PROCESSOR NUMBER (RANK)
!
      CALL mpi_comm_rank(comm,ipid,ier)
      IF(ier.NE.0) THEN
        WRITE(lu,*) 'P_INIT: ERROR IN MPI_COMM_RANK'
        WRITE(lu,*) 'MPI ERROR ',ier
        CALL plante(1)
        stop
      ENDIF
!
! OBTAINS NCSIZE
!
      CALL mpi_comm_size(comm,ncsize,ier)
      IF(ier.NE.0) THEN
        WRITE(lu,*) 'P_INIT: ERROR IN MPI_COMM_SIZE'
        WRITE(lu,*) 'MPI ERROR ',ier
        CALL plante(1)
        stop
      ENDIF
!
! MANIPULATES MASTER'S AND SLAVES' STANDART OUTPUT TO FILES PE#LOG.TXT
!
      IF(ncsize.GE.1) THEN
        pnumber = '00000-00000'
!
        IF((ncsize-1).LT.10) THEN
          WRITE(pnumber(05:05),'(I1)') ncsize-1
        ELSEIF((ncsize-1).LT.100) THEN
          WRITE(pnumber(04:05),'(I2)') ncsize-1
        ELSEIF((ncsize-1).LT.1000) THEN
          WRITE(pnumber(03:05),'(I3)') ncsize-1
        ELSEIF((ncsize-1).LT.10000) THEN
          WRITE(pnumber(02:05),'(I4)') ncsize-1
        ELSE
          WRITE(pnumber(01:05),'(I5)') ncsize-1
        ENDIF
!
        IF(ipid.LT.10) THEN
          WRITE(pnumber(11:11),'(I1)') ipid
        ELSEIF(ipid.LT.100) THEN
          WRITE(pnumber(10:11),'(I2)') ipid
        ELSEIF(ipid.LT.1000) THEN
          WRITE(pnumber(9:11),'(I3)') ipid
        ELSEIF(ipid.LT.10000) THEN
          WRITE(pnumber(8:11),'(I4)') ipid
        ELSE
          WRITE(pnumber(7:11),'(I5)') ipid
        ENDIF
        WRITE(mynam,'("PE", A11)') pnumber
!
      ENDIF
!
      IF(ipid.EQ.0) THEN
        IF(.NOT. std_output) THEN
          CALL get_free_id(lu)
          OPEN(unit=lu,file=mynam//'.LOG', form='FORMATTED',
     &           status='UNKNOWN')
        ENDIF
        WRITE(lu,*) 'MASTER PROCESSOR NUMBER ',
     &              ipid,' OF THE GROUP OF ',ncsize
      ELSE
!     THIS IS NOW HANDLED VIA mpirun OPTIONS
        CALL get_free_id(lu)
        OPEN(unit=lu,file=mynam//'.LOG', form='FORMATTED',
     &         status='UNKNOWN')
        WRITE(lu,*) 'SLAVE  PROCESSOR NUMBER ',
     &              ipid,' IN THE GROUP OF ',ncsize
      ENDIF
!
! READS THE NUMBER OF PROCESSORS AND NAME OF THE EXECUTABLE
!
      ncar=0
      npread=1
      yapara=.false.
      INQUIRE(file='./PARAL',exist=yapara)
      IF(yapara) THEN
        CALL get_free_id(id)
        OPEN(id,file='PARAL',form='FORMATTED',action='READ')
        READ(id,*) npread
        IF(npread.NE.ncsize) THEN
          WRITE (lu,*)
     &      'P_INIT: FILE PARAL IS INCONSISTENT WITH MPI PARAMETERS'
          WRITE (lu,*) 'MPI NCSIZE   = ',ncsize
          WRITE (lu,*) 'PARAL NCSIZE = ',npread
        ENDIF
        READ(id,*) ncar
        IF(ncar.GT.maxlentmpdir) THEN
          WRITE(lu,*) 'LENGTH OF TMP DIR STRING IS TO BIG'
          WRITE(lu,*) 'IT IS ',ncar,' LONG AND SHOULD NOT EXCEED',
     &                maxlentmpdir
          CALL plante(1)
        ENDIF
        READ(id,100) chaine
100     FORMAT(a250)
        exe(1:ncar+5)=chaine(1:ncar) // 'A.EXE'
        WRITE(lu,*) 'EXECUTABLE FILE: ',exe(1:ncar+5)
        CLOSE(id)
      ENDIF
!
! THE BARRIER USUALLY COMES UNEXPECTED
!
      CALL mpi_barrier(comm,ier)
      IF (ier.NE.0) THEN
        WRITE(lu,*) 'P_INIT: ERROR MPI_BARRIER'
        WRITE(lu,*) 'MPI ERROR ',ier
        CALL plante(1)
        stop
      ENDIF
#else
      ncar = 0
      chaine =' '
      ipid=0
      ncsize=0
      IF(.NOT. std_output) THEN
        CALL get_free_id(lu)
        OPEN(unit=lu,file='PE.LOG', form='FORMATTED',
     &         status='UNKNOWN')
      ENDIF
#endif
!
!-----------------------------------------------------------------------
!
      RETURN
      END