1! { dg-do run }
2! { dg-options "-std=legacy" }
3!
4! PR37707 Namelist read of array of derived type incorrect
5! Test case from PR, prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
6TYPE geometry
7   INTEGER :: nlon,nlat,nlev,projection
8   INTEGER :: center,subcenter,process
9   REAL    :: west,south,east,north
10   REAL    :: dlon,dlat
11   REAL    :: polat,polon
12   REAL    :: lonc,latc
13   REAL    :: projlat,projlat2,projlon
14   CHARACTER(LEN=1) :: arakawa ='#'
15   INTEGER :: truncx,truncy   ! Spectral truncation
16   INTEGER :: cie             ! Flag fort CI (0), CIE gridpoint (1)
17                              ! or CIE spectral (-1)
18   INTEGER :: nlat_i,nlon_i   ! I length in Y and X direction
19   INTEGER :: nlat_e ,nlon_e  ! E length in Y and X direction
20   LOGICAL :: do_geo = .true.
21END TYPE geometry
22
23TYPE shortkey
24   INTEGER           :: PPP !  2. Parameter
25   INTEGER           :: NNN ! 12. Gridpoint or spectral field 0 = gridpoint, 1 = spectral
26   INTEGER           :: INTPM
27   CHARACTER(LEN=16) :: name
28END TYPE shortkey
29INTEGER, PARAMETER :: maxl       = 200  ! Maximum number of levels to be read from namelist
30INTEGER, PARAMETER :: max_atmkey = 10   ! Maximum number of extra fields in the
31
32REAL    :: ahalf(maxl),bhalf(maxl)
33TYPE (geometry) :: outgeo ; SAVE outgeo  ! Output geometry
34
35TYPE (shortkey) ::  atmkey(max_atmkey) ; SAVE atmkey
36TYPE (shortkey) :: mlevkey(max_atmkey) ; SAVE mlevkey
37
38character*600 :: l = " &NAMINTERP atmkey%ppp = 076,058,062,079, atmkey%nnn = 000,000,000,000, &
39                     & atmkey%name ='LIQUID_WATER','SOLID_WATER','SNOW','RAIN', OUTGEO%NLEV=10, &
40                     & AHALF=0.,1.,2.,3.,4.,5.,6.,7.,8.,9., BHALF=0.,1.,2.,3.,4.,5.,6.,7.,8.,9., /"
41
42namelist /naminterp/outgeo,ahalf,bhalf,atmkey
43print *, outgeo%nlev
44read(l,nml=naminterp)
45if (outgeo%nlev /= 10) call abort
46if (any(ahalf(1:10) .ne. [0.,1.,2.,3.,4.,5.,6.,7.,8.,9.])) call abort
47if (any(bhalf(1:10) .ne. [0.,1.,2.,3.,4.,5.,6.,7.,8.,9.])) call abort
48if (any(atmkey(1:4)%ppp .ne. [076,058,062,079])) call abort
49if (any(atmkey(1:4)%nnn .ne. [0,0,0,0])) call abort
50if (any(atmkey(1:4)%name .ne. ['LIQUID_WATER','SOLID_WATER ','SNOW        ',&
51                              &'RAIN        '])) call abort
52end
53