org_charac_type_oil.F

Go to the documentation of this file.

!                   ******************************
                    SUBROUTINE org_charac_type_oil
!                   ******************************
!
     &(oil_charac)
!
!***********************************************************************
! PARALLEL   V6P3                                   21/08/2010
!***********************************************************************
!
!brief    MPI TYPE FOR TYPE CHARAC_TYPE - CHARACTERISTICS /
!
!history  C. DENIS
!+        01/07/2011
!+        V6P1
!+
!
!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
!
!history  J-M HERVOUET
!+        22/06/2012
!+        V6P2
!+   DX,DY and DZ added. Problem of integer 8 treated as a double
!+   solved. Much clearer now.
!+
!history  J-M HERVOUET
!+        04/10/2012
!+        V6P3
!+   NOMB = 0 now allowed
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| NOMB           |<---| NUMBER OF VARIABLES
!| TRACE          |<---| IF .TRUE. TRACE EXECUTION
!| CHARACTERISTIC |--->| DATATYPE FOR CHARACTERISTIC
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      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) :: OIL_CHARAC
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, PARAMETER :: MAX_BASKET_SIZE=10
!
!     OIL_TYPE IS NOT USED HERE !!!  NOT USED SAVE FOR TRACE
!
!     TYPE OIL_TYPE
!       SEQUENCE
!       INTEGER :: MYPID ! PARTITION OF THE TRACEBACK ORIGIN (HEAD)
!       INTEGER :: NEPID ! THE NEIGHBOUR PARTITION THE TRACEBACK ENTERS TO
!       INTEGER :: INE   ! THE LOCAL 2D ELEMENT NR THE TRACEBACK ENTERS IN THE NEIGBOUR PARTITION
!       INTEGER :: KNE   ! THE LOCAL LEVEL THE TRACEBACK ENTERS IN THE NEIGBOUR PARTITION
!       INTEGER :: IOR   ! THE POSITION OF THE TRAJECTORY -HEAD- IN MYPID [THE 2D/3D NODE OF ORIGIN]
!       INTEGER :: STATE   ! CURRENT RUNGE-KUTTA STEPS PASSED AS COLLECTED
!       INTEGER :: TPSECH   ! TOTAL RUNGE-KUTTA STEPS
!       INTEGER :: IFR   ! FREQUENCY
!       DOUBLE PRECISION :: SURFACE  ! THE (X,Y,Z,F)-POSITION
!       DOUBLE PRECISION :: MASS0
!       DOUBLE PRECISION :: MASS
!       DOUBLE PRECISION :: MASS_EVAP
!       DOUBLE PRECISION :: MASS_DISS
!       DOUBLE PRECISION :: MASS_HAP(MAX_BASKET_SIZE)
!       DOUBLE PRECISION :: MASS_COMPO(MAX_BASKET_SIZE)
!       DOUBLE PRECISION :: TB_HAP(MAX_BASKET_SIZE)
!       DOUBLE PRECISION :: TB_COMPO(MAX_BASKET_SIZE)
!       DOUBLE PRECISION :: SOL_HAP(MAX_BASKET_SIZE)
!       DOUBLE PRECISION :: SOL_COMPO(MAX_BASKET_SIZE)
!     END TYPE OIL_CHARAC_TYPE
!
!     ARRAY OF DISPLACEMENTS BETWEEN BASIC COMPONENTS, HERE INITIALISED ONLY
!
!      INTEGER (KIND=MPI_ADDRESS_KIND), DIMENSION(20) :: CH_DELTA
      INTEGER (KIND=MY_ADDRESS_KIND), DIMENSION(20) :: CH_DELTA
!
!     ARRAY OF BLOCKLENGTHS OF TYPE COMPONENTS, BASKET INITIALISED TO 1
!
      INTEGER, DIMENSION(20) :: CH_BLENGTH
!     ARRAY OF COMPONENT TYPES IN TERMS OF THE MPI COMMUNICATION
      INTEGER, DIMENSION(20) :: CH_TYPES
      INTEGER IER
!      INTEGER (KIND=MPI_ADDRESS_KIND) :: EXTENT,ILB,IUB,INTEX
      INTEGER (KIND=MY_ADDRESS_KIND) :: EXTENT,ILB,IUB,INTEX
!
      INTEGER I
!
      ch_blength=(/1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1/)
      ch_delta=  (/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
!
!     TERMINATE ON MPI PARTS NOT HANDLED BY COMPAD
#  if defined COMPAD
      WRITE(lu,*) 'ORG_CHARAC_TYPE_OIL: 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)=0
!     9 IS THE FIRST DOUBLE PRECISION THAT COMES AFTER AN INTEGER
      DO i=2,9
        ch_delta(i)=ch_delta(i-1)+intex
      ENDDO
!
!     DOUBLE PRECISION IN THE STRUCTURE
!
!     Handle components of active data type correctly
#ifdef 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 11 REMAINING DOUBLE PRECISION
      ch_delta(10)=ch_delta(9)+intex
      ch_delta(11)=ch_delta(10)+intex
      ch_delta(12)=ch_delta(11)+intex
      ch_delta(13)=ch_delta(12)+intex
      ch_delta(14)=ch_delta(13)+intex
!     ADDRESS AFTER THE BASKETCOMPO TABLE
      ch_delta(15)=ch_delta(14)+intex*max_basket_size
      ch_delta(16)=ch_delta(15)+intex*max_basket_size
!     ADDRESS AFTER THE BASKETHAP TABLE
      ch_delta(17)=ch_delta(16)+intex*max_basket_size
      ch_delta(18)=ch_delta(17)+intex*max_basket_size
      ch_delta(19)=ch_delta(18)+intex*max_basket_size
!     ADDRESS AFTER THE LAST HAP TABLE
      ch_delta(20)=ch_delta(19)+intex*max_basket_size
!
      ch_blength(14) = max_basket_size
      ch_blength(15) = max_basket_size
      ch_blength(16) = max_basket_size
      ch_blength(17) = max_basket_size
      ch_blength(18) = max_basket_size
      ch_blength(19) = max_basket_size
!
      ch_types(1)=mpi_integer
      ch_types(2)=mpi_integer
      ch_types(3)=mpi_integer
      ch_types(4)=mpi_integer
      ch_types(5)=mpi_integer
      ch_types(6)=mpi_integer
      ch_types(7)=mpi_integer
      ch_types(8)=mpi_integer
!! COMPAD-DCO  BEGIN  JR2017
!!   Handle components of active data type correctly
#if defined COMPAD
      ch_types(9)=ampi_type
      ch_types(10)=ampi_type
      ch_types(11)=ampi_type
      ch_types(12)=ampi_type
      ch_types(13)=ampi_type
      ch_types(14)=ampi_type
      ch_types(15)=ampi_type
      ch_types(16)=ampi_type
      ch_types(17)=ampi_type
      ch_types(18)=ampi_type
      ch_types(19)=ampi_type
#else
      ch_types(9)=mpi_double_precision
      ch_types(10)=mpi_double_precision
      ch_types(11)=mpi_double_precision
      ch_types(12)=mpi_double_precision
      ch_types(13)=mpi_double_precision
      ch_types(14)=mpi_double_precision
      ch_types(15)=mpi_double_precision
      ch_types(16)=mpi_double_precision
      ch_types(17)=mpi_double_precision
      ch_types(18)=mpi_double_precision
      ch_types(19)=mpi_double_precision
#endif
      ch_types(20)=mpi_ub       ! THE TYPE UPPER BOUND MARKER
      CALL p_mpi_type_create_struct(20,ch_blength,ch_delta,ch_types,
     &                              oil_charac,ier)
      CALL p_mpi_type_commit(oil_charac,ier)
      CALL p_mpi_type_get_extent(oil_charac,ilb,extent,ier)
      iub=ilb+extent
!
      IF(ilb.NE.ch_delta(1).OR.iub.NE.ch_delta(20)) THEN
        WRITE(lu,*) ' PARALLEL::ORG_CHARAC_TYPE_OIL:'
        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(20)=',
     &        ch_delta(20)
        CALL plante(1)
        stop
      ENDIF
!
!----------------------------------------------------------------------
!
      RETURN
      END SUBROUTINE org_charac_type_oil