1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
|
! { dg-do run }
!
! Tests fix for PR100120/100816/100818/100819/100821
!
program main_p
implicit none
integer, parameter :: k = 1
integer, parameter :: n = 11
integer, parameter :: m = 7
integer, parameter :: l = 3
integer, parameter :: u = 5
integer, parameter :: e = u-l+1
integer, parameter :: c = 61
character(kind=k), target :: c1(n)
character(len=m, kind=k), target :: cm(n)
!
character(kind=k), pointer :: s1
character(len=m, kind=k), pointer :: sm
character(len=e, kind=k), pointer :: se
character(len=:, kind=k), pointer :: sd
!
character(kind=k), pointer :: p1(:)
character(len=m, kind=k), pointer :: pm(:)
character(len=e, kind=k), pointer :: pe(:)
character(len=:, kind=k), pointer :: pd(:)
class(*), pointer :: su
class(*), pointer :: pu(:)
integer :: i, j
nullify(s1, sm, se, sd, su)
nullify(p1, pm, pe, pd, pu)
c1 = [(char(i+c, kind=k), i=1,n)]
do i = 1, n
do j = 1, m
cm(i)(j:j) = char(i*m+j+c-m, kind=k)
end do
end do
s1 => c1(n)
if(.not.associated(s1)) stop 1
if(.not.associated(s1, c1(n))) stop 2
if(len(s1)/=1) stop 3
if(s1/=c1(n)) stop 4
call schar_c1(s1)
call schar_a1(s1)
p1 => c1
if(.not.associated(p1)) stop 5
if(.not.associated(p1, c1)) stop 6
if(len(p1)/=1) stop 7
if(any(p1/=c1)) stop 8
call achar_c1(p1)
call achar_a1(p1)
!
sm => cm(n)
if(.not.associated(sm)) stop 9
if(.not.associated(sm, cm(n))) stop 10
if(len(sm)/=m) stop 11
if(sm/=cm(n)) stop 12
call schar_cm(sm)
call schar_am(sm)
pm => cm
if(.not.associated(pm)) stop 13
if(.not.associated(pm, cm)) stop 14
if(len(pm)/=m) stop 15
if(any(pm/=cm)) stop 16
call achar_cm(pm)
call achar_am(pm)
!
se => cm(n)(l:u)
if(.not.associated(se)) stop 17
if(.not.associated(se, cm(n)(l:u))) stop 18
if(len(se)/=e) stop 19
if(se/=cm(n)(l:u)) stop 20
call schar_ce(se)
call schar_ae(se)
pe => cm(:)(l:u)
if(.not.associated(pe)) stop 21
if(.not.associated(pe, cm(:)(l:u))) stop 22
if(len(pe)/=e) stop 23
if(any(pe/=cm(:)(l:u))) stop 24
call achar_ce(pe)
call achar_ae(pe)
!
sd => c1(n)
if(.not.associated(sd)) stop 25
if(.not.associated(sd, c1(n))) stop 26
if(len(sd)/=1) stop 27
if(sd/=c1(n)) stop 28
call schar_d1(sd)
pd => c1
if(.not.associated(pd)) stop 29
if(.not.associated(pd, c1)) stop 30
if(len(pd)/=1) stop 31
if(any(pd/=c1)) stop 32
call achar_d1(pd)
!
sd => cm(n)
if(.not.associated(sd)) stop 33
if(.not.associated(sd, cm(n))) stop 34
if(len(sd)/=m) stop 35
if(sd/=cm(n)) stop 36
call schar_dm(sd)
pd => cm
if(.not.associated(pd)) stop 37
if(.not.associated(pd, cm)) stop 38
if(len(pd)/=m) stop 39
if(any(pd/=cm)) stop 40
call achar_dm(pd)
!
sd => cm(n)(l:u)
if(.not.associated(sd)) stop 41
if(.not.associated(sd, cm(n)(l:u))) stop 42
if(len(sd)/=e) stop 43
if(sd/=cm(n)(l:u)) stop 44
call schar_de(sd)
pd => cm(:)(l:u)
if(.not.associated(pd)) stop 45
if(.not.associated(pd, cm(:)(l:u))) stop 46
if(len(pd)/=e) stop 47
if(any(pd/=cm(:)(l:u))) stop 48
call achar_de(pd)
!
sd => c1(n)
s1 => sd
if(.not.associated(s1)) stop 49
if(.not.associated(s1, c1(n))) stop 50
if(len(s1)/=1) stop 51
if(s1/=c1(n)) stop 52
call schar_c1(s1)
call schar_a1(s1)
pd => c1
s1 => pd(n)
if(.not.associated(s1)) stop 53
if(.not.associated(s1, c1(n))) stop 54
if(len(s1)/=1) stop 55
if(s1/=c1(n)) stop 56
call schar_c1(s1)
call schar_a1(s1)
pd => c1
p1 => pd
if(.not.associated(p1)) stop 57
if(.not.associated(p1, c1)) stop 58
if(len(p1)/=1) stop 59
if(any(p1/=c1)) stop 60
call achar_c1(p1)
call achar_a1(p1)
!
sd => cm(n)
sm => sd
if(.not.associated(sm)) stop 61
if(.not.associated(sm, cm(n))) stop 62
if(len(sm)/=m) stop 63
if(sm/=cm(n)) stop 64
call schar_cm(sm)
call schar_am(sm)
pd => cm
sm => pd(n)
if(.not.associated(sm)) stop 65
if(.not.associated(sm, cm(n))) stop 66
if(len(sm)/=m) stop 67
if(sm/=cm(n)) stop 68
call schar_cm(sm)
call schar_am(sm)
pd => cm
pm => pd
if(.not.associated(pm)) stop 69
if(.not.associated(pm, cm)) stop 70
if(len(pm)/=m) stop 71
if(any(pm/=cm)) stop 72
call achar_cm(pm)
call achar_am(pm)
!
sd => cm(n)(l:u)
se => sd
if(.not.associated(se)) stop 73
if(.not.associated(se, cm(n)(l:u))) stop 74
if(len(se)/=e) stop 75
if(se/=cm(n)(l:u)) stop 76
call schar_ce(se)
call schar_ae(se)
pd => cm(:)(l:u)
pe => pd
if(.not.associated(pe)) stop 77
if(.not.associated(pe, cm(:)(l:u))) stop 78
if(len(pe)/=e) stop 79
if(any(pe/=cm(:)(l:u))) stop 80
call achar_ce(pe)
call achar_ae(pe)
!
su => c1(n)
if(.not.associated(su)) stop 81
if(.not.associated(su, c1(n))) stop 82
select type(su)
type is(character(len=*, kind=k))
if(len(su)/=1) stop 83
if(su/=c1(n)) stop 84
class default
stop 85
end select
call schar_u1(su)
pu => c1
if(.not.associated(pu)) stop 86
if(.not.associated(pu, c1)) stop 87
select type(pu)
type is(character(len=*, kind=k))
if(len(pu)/=1) stop 88
if(any(pu/=c1)) stop 89
class default
stop 90
end select
call achar_u1(pu)
!
su => cm(n)
if(.not.associated(su)) stop 91
if(.not.associated(su)) stop 92
if(.not.associated(su, cm(n))) stop 93
select type(su)
type is(character(len=*, kind=k))
if(len(su)/=m) stop 94
if(su/=cm(n)) stop 95
class default
stop 96
end select
call schar_um(su)
pu => cm
if(.not.associated(pu)) stop 97
if(.not.associated(pu, cm)) stop 98
select type(pu)
type is(character(len=*, kind=k))
if(len(pu)/=m) stop 99
if(any(pu/=cm)) stop 100
class default
stop 101
end select
call achar_um(pu)
!
su => cm(n)(l:u)
if(.not.associated(su)) stop 102
if(.not.associated(su, cm(n)(l:u))) stop 103
select type(su)
type is(character(len=*, kind=k))
if(len(su)/=e) stop 104
if(su/=cm(n)(l:u)) stop 105
class default
stop 106
end select
call schar_ue(su)
pu => cm(:)(l:u)
if(.not.associated(pu)) stop 107
if(.not.associated(pu, cm(:)(l:u))) stop 108
select type(pu)
type is(character(len=*, kind=k))
if(len(pu)/=e) stop 109
if(any(pu/=cm(:)(l:u))) stop 110
class default
stop 111
end select
call achar_ue(pu)
!
sd => c1(n)
su => sd
if(.not.associated(su)) stop 112
if(.not.associated(su, c1(n))) stop 113
select type(su)
type is(character(len=*, kind=k))
if(len(su)/=1) stop 114
if(su/=c1(n)) stop 115
class default
stop 116
end select
call schar_u1(su)
pd => c1
su => pd(n)
if(.not.associated(su)) stop 117
if(.not.associated(su, c1(n))) stop 118
select type(su)
type is(character(len=*, kind=k))
if(len(su)/=1) stop 119
if(su/=c1(n)) stop 120
class default
stop 121
end select
call schar_u1(su)
pd => c1
pu => pd
if(.not.associated(pu)) stop 122
if(.not.associated(pu, c1)) stop 123
select type(pu)
type is(character(len=*, kind=k))
if(len(pu)/=1) stop 124
if(any(pu/=c1)) stop 125
class default
stop 126
end select
call achar_u1(pu)
!
sd => cm(n)
su => sd
if(.not.associated(su)) stop 127
if(.not.associated(su, cm(n))) stop 128
select type(su)
type is(character(len=*, kind=k))
if(len(su)/=m) stop 129
if(su/=cm(n)) stop 130
class default
stop 131
end select
call schar_um(su)
pd => cm
su => pd(n)
if(.not.associated(su)) stop 132
if(.not.associated(su, cm(n))) stop 133
select type(su)
type is(character(len=*, kind=k))
if(len(su)/=m) stop 134
if(su/=cm(n)) stop 135
class default
stop 136
end select
call schar_um(su)
pd => cm
pu => pd
if(.not.associated(pu)) stop 137
if(.not.associated(pu, cm)) stop 138
select type(pu)
type is(character(len=*, kind=k))
if(len(pu)/=m) stop 139
if(any(pu/=cm)) stop 140
class default
stop 141
end select
call achar_um(pu)
!
sd => cm(n)(l:u)
su => sd
if(.not.associated(su)) stop 142
if(.not.associated(su, cm(n)(l:u))) stop 143
select type(su)
type is(character(len=*, kind=k))
if(len(su)/=e) stop 144
if(su/=cm(n)(l:u)) stop 145
class default
stop 146
end select
call schar_ue(su)
pd => cm(:)(l:u)
su => pd(n)
if(.not.associated(su)) stop 147
if(.not.associated(su, cm(n)(l:u))) stop 148
select type(su)
type is(character(len=*, kind=k))
if(len(su)/=e) stop 149
if(su/=cm(n)(l:u)) stop 150
class default
stop 151
end select
call schar_ue(su)
pd => cm(:)(l:u)
pu => pd
if(.not.associated(pu)) stop 152
if(.not.associated(pu, cm(:)(l:u))) stop 153
select type(pu)
type is(character(len=*, kind=k))
if(len(pu)/=e) stop 154
if(any(pu/=cm(:)(l:u))) stop 155
class default
stop 156
end select
call achar_ue(pu)
!
sd => cm(n)
su => sd(l:u)
if(.not.associated(su)) stop 157
if(.not.associated(su, cm(n)(l:u))) stop 158
select type(su)
type is(character(len=*, kind=k))
if(len(su)/=e) stop 159
if(su/=cm(n)(l:u)) stop 160
class default
stop 161
end select
call schar_ue(su)
pd => cm(:)
su => pd(n)(l:u)
if(.not.associated(su)) stop 162
if(.not.associated(su, cm(n)(l:u))) stop 163
select type(su)
type is(character(len=*, kind=k))
if(len(su)/=e) stop 164
if(su/=cm(n)(l:u)) stop 165
class default
stop 166
end select
call schar_ue(su)
pd => cm
pu => pd(:)(l:u)
if(.not.associated(pu)) stop 167
if(.not.associated(pu, cm(:)(l:u))) stop 168
select type(pu)
type is(character(len=*, kind=k))
if(len(pu)/=e) stop 169
if(any(pu/=cm(:)(l:u))) stop 170
class default
stop 171
end select
call achar_ue(pu)
!
stop
contains
subroutine schar_c1(a)
character(kind=k), pointer, intent(in) :: a
if(.not.associated(a)) stop 172
if(.not.associated(a, c1(n))) stop 173
if(len(a)/=1) stop 174
if(a/=c1(n)) stop 175
return
end subroutine schar_c1
subroutine achar_c1(a)
character(kind=k), pointer, intent(in) :: a(:)
if(.not.associated(a)) stop 176
if(.not.associated(a, c1)) stop 177
if(len(a)/=1) stop 178
if(any(a/=c1)) stop 179
return
end subroutine achar_c1
subroutine schar_cm(a)
character(kind=k, len=m), pointer, intent(in) :: a
if(.not.associated(a)) stop 180
if(.not.associated(a, cm(n))) stop 181
if(len(a)/=m) stop 182
if(a/=cm(n)) stop 183
return
end subroutine schar_cm
subroutine achar_cm(a)
character(kind=k, len=m), pointer, intent(in) :: a(:)
if(.not.associated(a)) stop 184
if(.not.associated(a, cm)) stop 185
if(len(a)/=m) stop 186
if(any(a/=cm)) stop 187
return
end subroutine achar_cm
subroutine schar_ce(a)
character(kind=k, len=e), pointer, intent(in) :: a
if(.not.associated(a)) stop 188
if(.not.associated(a, cm(n)(l:u))) stop 189
if(len(a)/=e) stop 190
if(a/=cm(n)(l:u)) stop 191
return
end subroutine schar_ce
subroutine achar_ce(a)
character(kind=k, len=e), pointer, intent(in) :: a(:)
if(.not.associated(a)) stop 192
if(.not.associated(a, cm(:)(l:u))) stop 193
if(len(a)/=e) stop 194
if(any(a/=cm(:)(l:u))) stop 195
return
end subroutine achar_ce
subroutine schar_a1(a)
character(kind=k, len=*), pointer, intent(in) :: a
if(.not.associated(a)) stop 196
if(.not.associated(a, c1(n))) stop 197
if(len(a)/=1) stop 198
if(a/=c1(n)) stop 199
return
end subroutine schar_a1
subroutine achar_a1(a)
character(kind=k, len=*), pointer, intent(in) :: a(:)
if(.not.associated(a)) stop 200
if(.not.associated(a, c1)) stop 201
if(len(a)/=1) stop 202
if(any(a/=c1)) stop 203
return
end subroutine achar_a1
subroutine schar_am(a)
character(kind=k, len=*), pointer, intent(in) :: a
if(.not.associated(a)) stop 204
if(.not.associated(a, cm(n))) stop 205
if(len(a)/=m) stop 206
if(a/=cm(n)) stop 207
return
end subroutine schar_am
subroutine achar_am(a)
character(kind=k, len=*), pointer, intent(in) :: a(:)
if(.not.associated(a)) stop 208
if(.not.associated(a, cm)) stop 209
if(len(a)/=m) stop 210
if(any(a/=cm)) stop 211
return
end subroutine achar_am
subroutine schar_ae(a)
character(kind=k, len=*), pointer, intent(in) :: a
if(.not.associated(a)) stop 212
if(.not.associated(a, cm(n)(l:u))) stop 213
if(len(a)/=e) stop 214
if(a/=cm(n)(l:u)) stop 215
return
end subroutine schar_ae
subroutine achar_ae(a)
character(kind=k, len=*), pointer, intent(in) :: a(:)
if(.not.associated(a)) stop 216
if(.not.associated(a, cm(:)(l:u))) stop 217
if(len(a)/=e) stop 218
if(any(a/=cm(:)(l:u))) stop 219
return
end subroutine achar_ae
subroutine schar_d1(a)
character(kind=k, len=:), pointer, intent(in) :: a
if(.not.associated(a)) stop 220
if(.not.associated(a, c1(n))) stop 221
if(len(a)/=1) stop 222
if(a/=c1(n)) stop 223
return
end subroutine schar_d1
subroutine achar_d1(a)
character(kind=k, len=:), pointer, intent(in) :: a(:)
if(.not.associated(a)) stop 224
if(.not.associated(a, c1)) stop 225
if(len(a)/=1) stop 226
if(any(a/=c1)) stop 227
return
end subroutine achar_d1
subroutine schar_dm(a)
character(kind=k, len=:), pointer, intent(in) :: a
if(.not.associated(a)) stop 228
if(.not.associated(a, cm(n))) stop 229
if(len(a)/=m) stop 230
if(a/=cm(n)) stop 231
return
end subroutine schar_dm
subroutine achar_dm(a)
character(kind=k, len=:), pointer, intent(in) :: a(:)
if(.not.associated(a)) stop 232
if(.not.associated(a, cm)) stop 233
if(len(a)/=m) stop 234
if(any(a/=cm)) stop 235
return
end subroutine achar_dm
subroutine schar_de(a)
character(kind=k, len=:), pointer, intent(in) :: a
if(.not.associated(a)) stop 236
if(.not.associated(a, cm(n)(l:u))) stop 237
if(len(a)/=e) stop 238
if(a/=cm(n)(l:u)) stop 239
return
end subroutine schar_de
subroutine achar_de(a)
character(kind=k, len=:), pointer, intent(in) :: a(:)
if(.not.associated(a)) stop 240
if(.not.associated(a, cm(:)(l:u))) stop 241
if(len(a)/=e) stop 242
if(any(a/=cm(:)(l:u))) stop 243
return
end subroutine achar_de
subroutine schar_u1(a)
class(*), pointer, intent(in) :: a
if(.not.associated(a)) stop 244
if(.not.associated(a, c1(n))) stop 245
select type(a)
type is(character(len=*, kind=k))
if(len(a)/=1) stop 246
if(a/=c1(n)) stop 247
class default
stop 248
end select
return
end subroutine schar_u1
subroutine achar_u1(a)
class(*), pointer, intent(in) :: a(:)
if(.not.associated(a)) stop 249
if(.not.associated(a, c1)) stop 250
select type(a)
type is(character(len=*, kind=k))
if(len(a)/=1) stop 251
if(any(a/=c1)) stop 252
class default
stop 253
end select
return
end subroutine achar_u1
subroutine schar_um(a)
class(*), pointer, intent(in) :: a
if(.not.associated(a)) stop 254
if(.not.associated(a)) stop 255
if(.not.associated(a, cm(n))) stop 256
select type(a)
type is(character(len=*, kind=k))
if(len(a)/=m) stop 257
if(a/=cm(n)) stop 258
class default
stop 259
end select
return
end subroutine schar_um
subroutine achar_um(a)
class(*), pointer, intent(in) :: a(:)
if(.not.associated(a)) stop 260
if(.not.associated(a, cm)) stop 261
select type(a)
type is(character(len=*, kind=k))
if(len(a)/=m) stop 262
if(any(a/=cm)) stop 263
class default
stop 264
end select
return
end subroutine achar_um
subroutine schar_ue(a)
class(*), pointer, intent(in) :: a
if(.not.associated(a)) stop 265
if(.not.associated(a, cm(n)(l:u))) stop 266
select type(a)
type is(character(len=*, kind=k))
if(len(a)/=e) stop 267
if(a/=cm(n)(l:u)) stop 268
class default
stop 269
end select
return
end subroutine schar_ue
subroutine achar_ue(a)
class(*), pointer, intent(in) :: a(:)
if(.not.associated(a)) stop 270
if(.not.associated(a, cm(:)(l:u))) stop 271
select type(a)
type is(character(len=*, kind=k))
if(len(a)/=e) stop 272
if(any(a/=cm(:)(l:u))) stop 273
class default
stop 274
end select
return
end subroutine achar_ue
end program main_p
|
