1! { dg-do run } 2 subroutine test_lower 3 implicit none 4 character(3), dimension(3) :: zsymel,zsymelr 5 common /xx/ zsymel, zsymelr 6 integer :: znsymelr 7 zsymel = (/ 'X', 'Y', ' ' /) 8 zsymelr= (/ 'X', 'Y', ' ' /) 9 znsymelr=2 10 call check_zsymel(zsymel,zsymelr,znsymelr) 11 12 contains 13 14 subroutine check_zsymel(zsymel,zsymelr,znsymelr) 15 implicit none 16 integer znsymelr, isym 17 character(*) zsymel(*),zsymelr(*) 18 character(len=80) buf 19 zsymel(3)(lenstr(zsymel(3))+1:)='X' 20 write (buf,10) (trim(zsymelr(isym)),isym=1,znsymelr) 2110 format(3(a,:,',')) 22 if (trim(buf) /= 'X,Y') call abort 23 end subroutine check_zsymel 24 25 function lenstr(s) 26 character(len=*),intent(in) :: s 27 integer :: lenstr 28 if (len_trim(s) /= 0) call abort 29 lenstr = len_trim(s) 30 end function lenstr 31 32 end subroutine test_lower 33 34 subroutine test_upper 35 implicit none 36 character(3), dimension(3) :: zsymel,zsymelr 37 common /xx/ zsymel, zsymelr 38 integer :: znsymelr 39 zsymel = (/ 'X', 'Y', ' ' /) 40 zsymelr= (/ 'X', 'Y', ' ' /) 41 znsymelr=2 42 call check_zsymel(zsymel,zsymelr,znsymelr) 43 44 contains 45 46 subroutine check_zsymel(zsymel,zsymelr,znsymelr) 47 implicit none 48 integer znsymelr, isym 49 character(*) zsymel(*),zsymelr(*) 50 character(len=80) buf 51 zsymel(3)(:lenstr(zsymel(3))+1)='X' 52 write (buf,20) (trim(zsymelr(isym)),isym=1,znsymelr) 5320 format(3(a,:,',')) 54 if (trim(buf) /= 'X,Y') call abort 55 end subroutine check_zsymel 56 57 function lenstr(s) 58 character(len=*),intent(in) :: s 59 integer :: lenstr 60 if (len_trim(s) /= 0) call abort 61 lenstr = len_trim(s) 62 end function lenstr 63 64 end subroutine test_upper 65 66 program test 67 call test_lower 68 call test_upper 69 end program test 70