gcc/testsuite/gfortran.dg/pointer_array_2.f90

   1 ! { dg-do compile }
   2 !
   3 ! Test the fix for PR40737 as part of the overall fix for PR34640.
   4 !
   5 ! Contributed by David Hough  <dh458@oakapple.net>
   6 !
   7 module testmod
   8
   9 integer, parameter :: standard_integer = 1
  10 integer, parameter :: int = KIND( standard_integer)
  11
  12 integer, parameter :: i8  = selected_int_kind(12)
  13 integer, parameter :: i4  = selected_int_kind(8)
  14 integer, parameter :: i2  = selected_int_kind(4)
  15
  16 integer, parameter :: standard_real = 1.
  17 integer, parameter :: std_real = KIND( standard_real)
  18
  19 integer, parameter :: r8  = selected_real_kind(12)
  20 integer, parameter :: r4  = selected_real_kind(6)
  21 integer, parameter :: double  = selected_real_kind(20)
  22
  23 integer, parameter :: name_string_length = 40
  24 integer, parameter :: file_name_length = 60
  25 integer, parameter :: text_string_length = 80
  26 integer, parameter :: max_kwd_lgth = file_name_length
  27
  28 integer(int) :: bytes_per_int  = 4
  29 integer(int) :: bytes_per_real = 8
  30 integer(int) :: workcomm, spincomm
  31
  32    integer(int), parameter :: nb_directions = 3,  &
  33                               direction_x = 1,    &
  34                               direction_y = 2,    &
  35                               direction_z = 3,    &
  36                               nb_ghost_cells = 5     ! might be different for the lagrange step?
  37
  38    integer(int), parameter :: ends = 4,            &
  39                               lower_ghost = 1,     &
  40                               lower_interior = 2,  &
  41                               upper_interior = 3,  &
  42                               upper_ghost = 4
  43
  44    ! Neighbors
  45    integer(int), parameter :: side = 2,       &
  46                               lower_end = 1,  &
  47                               upper_end = 2
  48
  49
  50    integer(int), parameter :: nb_variables = 5,    &
  51                               ro_var = 1,          &
  52                               ets_var = 2,         &
  53                               u_var = 3,           &
  54                               up1_var = 4,         &
  55                               up2_var = 5,         &
  56                               eis_var = 6,         &
  57                               ecs_var = 7,         &
  58                               p_var = 8,           &
  59                               c_var = 9,           &
  60                               nb_var_sortie = 9
  61
  62    type :: VARIABLES_LIGNE
  63       sequence
  64       real, pointer, dimension( :, :) :: l
  65    end type VARIABLES_LIGNE
  66
  67    type VARIABLES_MAILLE
  68       sequence
  69       real(r8), dimension( nb_variables) :: cell_var
  70    end type VARIABLES_MAILLE
  71
  72    integer(int), dimension( nb_directions) :: &
  73          first_real_cell,    &  ! without ghost cells
  74          last_real_cell,     &  !
  75          nb_real_cells,      &  !
  76          first_work_cell,    &  ! including ghost cells
  77          last_work_cell,     &  !
  78          nb_work_cells,      &  !
  79          global_nb_cells        ! number of real cells, for the entire grid
  80
  81    integer(int) :: dim_probleme  ! dimension du probleme (1, 2 ou 3)
  82
  83    integer(int) :: largest_local_size   ! the largest of the 3 dimensions of the local grid
  84
  85    ! Hydro variables of the actual domain
  86    ! There are 3 copies of these, for use according to current work direction
  87    type (VARIABLES_MAILLE), allocatable, target, dimension( :, :, :) ::  &
  88             Hydro_vars_XYZ,  &
  89             Hydro_vars_YZX,  &
  90             Hydro_vars_ZXY
  91
  92    ! Pointers to current and next Hydro var arrays
  93    type (VARIABLES_MAILLE), pointer, dimension( :, :, :) :: Hydro_vars,      &
  94                                                             Hydro_vars_next
  95
  96    ! Which of these 3 copies of the 3D arrays has been updated last
  97    integer(int) :: last_updated_3D_array = 0
  98
  99    real(r8), pointer, dimension( :) ::        &
 100          ! Variables "permanentes" (entrant dans la projection)
 101          Ro,      & ! densite
 102          Ets,     & ! energie totale specifique
 103          Um,      & ! vitesse aux mailles, dans la direction de travail
 104          Xn,      & ! abscisse en fin de pas de temps
 105          ! Variables en lecture seulement
 106          Um_p1,   & ! vitesse aux mailles, dans les directions
 107          Um_p2,   & !                      orthogonales
 108          Xa,      & ! abscisses des noeuds en debut de pas de temps
 109          Dxa,     & ! longueur des mailles en debut de pas de temps
 110          U_dxa      ! inverses des longueurs des mailles
 111
 112 end module testmod
 113
 114
 115 subroutine TF_AD_SPLITTING_DRIVER_PLANE
 116
 117 use testmod
 118
 119 implicit none
 120 save
 121
 122    real(r8), allocatable, dimension( :) ::  &
 123          ! Variables maille recalculees a chaque pas de temps
 124          Eis,     & ! energie interne specifique (seulement pour calculer la pression)
 125          Vit_son, & ! comme son nom l'indique
 126          C_f_l,   & ! nombre de Courant
 127          Pm,      & ! pression aux mailles
 128          ! Variables aux noeuds
 129          Un,      & ! vitesse des noeuds
 130          Pn         ! pression aux noeuds
 131
 132
 133 integer(int) :: i, j, k
 134 integer(int) :: first_cell, last_cell
 135
 136          Ro => Hydro_vars( first_cell:last_cell, j, k)%cell_var( ro_var)
 137          Ets => Hydro_vars( first_cell:last_cell, j, k)%cell_var( ets_var)
 138          Um => Hydro_vars( first_cell:last_cell, j, k)%cell_var( u_var)
 139          Um_p1 => Hydro_vars( first_cell:last_cell, j, k)%cell_var( up1_var)
 140          Um_p2 => Hydro_vars( first_cell:last_cell, j, k)%cell_var( up2_var)
 141
 142 end subroutine TF_AD_SPLITTING_DRIVER_PLANE
 143