org_charac_type_alg.F

Go to the documentation of this file.

!                   ******************************
                    SUBROUTINE org_charac_type_alg
!                   ******************************
!
     &(alg_char,nomb)
!
!***********************************************************************
! PARALLEL   V6P3                                   21/08/2010
!***********************************************************************
!
!brief    RETURNS THE MPI TYPE FOR TYPE ALG_CHAR
!
!history  A. JOLY
!+        22/05/2013
!+        V6P3
!+   First version
!
!history  M.S.TURNBULL (HRW)
!+        18/11/2019
!+        V8P2
!+   Updated to include ICLASS, DISLODGE and TEFF
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| ALG_CHAR       |<-->| MPI TYPE FOR TYPE CHARAC_TYPE - ALG_CHAR
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_parallel
      USE declarations_special
      USE interface_parallel, ONLY : p_mpi_type_get_extent,
     &     p_mpi_type_create_struct, p_mpi_type_commit
      IMPLICIT NONE
!
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(INOUT) :: ALG_CHAR
      INTEGER, INTENT(IN)    :: NOMB
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
!     ARRAY OF DISPLACEMENTS BETWEEN BASIC COMPONENTS, HERE INITIALISED ONLY
!
#if defined HAVE_MPI
      INTEGER (KIND=MY_ADDRESS_KIND), DIMENSION(21) :: CH_DELTA
!
!     ARRAY OF BLOCKLENGTHS OF TYPE COMPONENTS, BASKET INITIALISED TO 1
!
      INTEGER, DIMENSION(21) :: CH_BLENGTH
!     ARRAY OF COMPONENT TYPES IN TERMS OF THE MPI COMMUNICATION
      INTEGER, DIMENSION(21) :: CH_TYPES
      INTEGER IER,I
      INTEGER (KIND=MY_ADDRESS_KIND) :: EXTENT,ILB,IUB,INTEX
!
!----------------------------------------------------------------------
!
!     THE CODE BELOW HERE MUST BE CONSISTENT WITH THIS TYPE:
!
!     TYPE ALG_TYPE
!       SEQUENCE   ! NECESSARY TO DEFINE MPI TYPE
!       INTEGER :: MYPID ! PARTITION OF THE TRACEBACK ORIGIN (HEAD)
!       INTEGER :: NEPID ! THE NEIGHBOUR PARTITION THE TRACEBACK ENTERS TO
!       INTEGER :: IGLOB  ! THE GLOBAL NUMBER OF THE PARTICLES
!       INTEGER :: FLAG  ! USED TO ALIGN FIELDS
!       INTEGER :: ICLASS ! THE ALGAE CLASS
!       INTEGER :: DISLODGE ! 0 : NOT DISLODGED. 1 : DISLODGED.
!       DOUBLE PRECISION :: VX,VY,VZ  ! THE (X,Y,Z) PARTICLE VELOCITY
!       DOUBLE PRECISION :: UX,UY,UZ  ! THE (X,Y,Z) FLUID VELOCITY
!       DOUBLE PRECISION :: UX_AV,UY_AV,UZ_AV  ! THE (X,Y,Z) AVERAGE FLUID VELOCITY
!       DOUBLE PRECISION :: K_AV,EPS_AV  ! THE VALUES OF K AND EPS
!       DOUBLE PRECISION :: H_FLU  ! THE WATER DEPTH AT POSITION OF VELOCITY
!       DOUBLE PRECISION :: TEFF ! EFFECTIVE TIME OF ALGAE DEGRADATION
!       DOUBLE PRECISION :: PSI(3*101) ! VARIABLE PSI USED FOR THE BASSET FORCE
!     END TYPE ALG_TYPE
!
      ch_blength=1
      ch_delta=0
!
!     TERMINATE ON MPI PARTS NOT HANDLED BY COMPAD
#  if defined COMPAD
      WRITE(lu,*) 'ORG_CHARAC_TYPE_ALG: COMPAD MAYBE CRITICAL',
     &     'MPI OPERATION'
      WRITE(lu,*) '  PLEASE CONTACT JR @ ADJOINTWARE'
      CALL plante(1)
      stop
#  endif
!     INTEGERS IN THE STRUCTURE
!
      CALL p_mpi_type_get_extent(mpi_integer,ilb,intex,ier)
      ch_delta(1)=ilb
!     7 IS THE FIRST DOUBLE PRECISION THAT COMES AFTER AN INTEGER
      DO i=2,7
        ch_delta(i)=ch_delta(i-1)+intex
      ENDDO
!
!     DOUBLE PRECISION IN THE STRUCTURE
!
!     Handle components of active data type correctly
#  if defined COMPAD
      CALL p_mpi_type_get_extent(ampi_type,ilb,intex,ier)
#  else
      CALL p_mpi_type_get_extent(mpi_double_precision,ilb,intex,ier)
#  endif
!     THE 14 REMAINING DOUBLE PRECISION (INCLUDING BASKET)
      DO i=8,19
        ch_delta(i)=ch_delta(i-1)+intex
      ENDDO
!
!     INDEX FOR PSI
!
      ch_delta(20)=ch_delta(19)+intex
!     ADDRESS AFTER THE THE LAST DOUBLE PRECISION
      ch_delta(21)=ch_delta(20)+intex*3*101
!
!     CHECKING NOMB
!
      IF(nomb.GT.3*101) THEN
        WRITE (lu,*) 'PARALLEL::ORG_CHARAC_TYPE_ALG'
        WRITE (lu,*) 'NOMB>3*101 ==> NWIN OR NDIR BADLY DEFINED'
        WRITE (lu,*) 'NWIN SHOULD BE 100'
        WRITE (lu,*) 'NDIR SHOULD BE 2 OR 3'
!       CALL PLANTE(1)
        stop
      ENDIF
      ch_blength(20) = nomb
!
      ch_types(1) =mpi_integer          !MYPID
      ch_types(2) =mpi_integer          !NEPID
      ch_types(3) =mpi_integer          !IGLOB
      ch_types(4) =mpi_integer          !FLAG
      ch_types(5) =mpi_integer          !ICLASS
      ch_types(6) =mpi_integer          !DISLODGE
!     Handle components of active data type correctly
#  if defined COMPAD
      ch_types(7) =ampi_type !VX
      ch_types(8) =ampi_type !VY
      ch_types(9) =ampi_type !VZ
      ch_types(10) =ampi_type !UX
      ch_types(11) =ampi_type !UY
      ch_types(12)=ampi_type !UZ
      ch_types(13)=ampi_type !UX_AV
      ch_types(14)=ampi_type !UY_AV
      ch_types(15)=ampi_type !UZ_AV
      ch_types(16)=ampi_type !K_AV
      ch_types(17)=ampi_type !EPS_AV
      ch_types(18)=ampi_type !H_FLU
      ch_types(19)=ampi_type !TEFF
      ch_types(20)=ampi_type !PSI
#  else
      ch_types(7) =mpi_double_precision !VX
      ch_types(8) =mpi_double_precision !VY
      ch_types(9) =mpi_double_precision !VZ
      ch_types(10) =mpi_double_precision !UX
      ch_types(11) =mpi_double_precision !UY
      ch_types(12)=mpi_double_precision !UZ
      ch_types(13)=mpi_double_precision !UX_AV
      ch_types(14)=mpi_double_precision !UY_AV
      ch_types(15)=mpi_double_precision !UZ_AV
      ch_types(16)=mpi_double_precision !K_AV
      ch_types(17)=mpi_double_precision !EPS_AV
      ch_types(18)=mpi_double_precision !H_FLU
      ch_types(19)=mpi_double_precision !TEFF
      ch_types(20)=mpi_double_precision !PSI
#  endif
      ch_types(21)=mpi_ub               !THE TYPE UPPER BOUND MARKER
      CALL p_mpi_type_create_struct(21,ch_blength,ch_delta,ch_types,
     &                              alg_char,ier)

      CALL p_mpi_type_commit(alg_char,ier)

      CALL p_mpi_type_get_extent(alg_char,ilb,extent,ier)

      iub=ilb+extent
!
      IF(ilb.NE.ch_delta(1).OR.iub.NE.ch_delta(21)) THEN
        WRITE(lu,*) ' PARALLEL::ORG_CHARAC_TYPE_ALG:'
        WRITE(lu,*) ' MEMORY PROBLEM WITH THIS COMPILER: '
        WRITE(lu,*) ' ILB=',ilb,' NOT EQUAL TO CH_DELTA(1)=',
     &        ch_delta(1)
        WRITE(lu,*) ' OR'
        WRITE(lu,*) ' IUB=',iub,' NOT EQUAL TO CH_DELTA(21)=',
     &        ch_delta(21)
        CALL plante(1)
        stop
      ENDIF
      RETURN
#else
      WRITE(lu,*) 'CALL OF P_SYNC IN ITS VOID VERSION'
#endif
!
!----------------------------------------------------------------------
!
      END SUBROUTINE org_charac_type_alg