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!
7module testmod
8
9integer, parameter :: standard_integer = 1
10integer, parameter :: int = KIND( standard_integer)
11
12integer, parameter :: i8  = selected_int_kind(12)
13integer, parameter :: i4  = selected_int_kind(8)
14integer, parameter :: i2  = selected_int_kind(4)
15
16integer, parameter :: standard_real = 1.
17integer, parameter :: std_real = KIND( standard_real)
18
19integer, parameter :: r8  = selected_real_kind(12)
20integer, parameter :: r4  = selected_real_kind(6)
21integer, parameter :: double  = selected_real_kind(20)
22
23integer, parameter :: name_string_length = 40
24integer, parameter :: file_name_length = 60
25integer, parameter :: text_string_length = 80
26integer, parameter :: max_kwd_lgth = file_name_length
27
28integer(int) :: bytes_per_int  = 4
29integer(int) :: bytes_per_real = 8
30integer(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
112end module testmod
113
114
115subroutine TF_AD_SPLITTING_DRIVER_PLANE
116
117use testmod
118
119implicit none
120save
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
133integer(int) :: i, j, k
134integer(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
142end subroutine TF_AD_SPLITTING_DRIVER_PLANE
143
144