gcc/testsuite/gfortran.dg/entry_20.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR fortran/50898
   4 ! A symbol was freed prematurely during resolution,
   5 ! despite remaining reachable
   6 !
   7 ! Original testcase from <shaojuncycle@gmail.com>
   8
   9 MODULE MODULE_pmat2
  10
  11 IMPLICIT NONE
  12
  13 INTERFACE cad1b;  MODULE PROCEDURE cad1b;          END INTERFACE
  14 INTERFACE csb1b;  MODULE PROCEDURE csb1b;          END INTERFACE
  15 INTERFACE copbt;  MODULE PROCEDURE copbt;          END INTERFACE
  16 INTERFACE conbt;  MODULE PROCEDURE conbt;          END INTERFACE
  17 INTERFACE copmb;  MODULE PROCEDURE copmb;          END INTERFACE
  18 INTERFACE conmb;  MODULE PROCEDURE conmb;          END INTERFACE
  19 INTERFACE copbm;  MODULE PROCEDURE copbm;          END INTERFACE
  20 INTERFACE conbm;  MODULE PROCEDURE conbm;          END INTERFACE
  21 INTERFACE mulvb;  MODULE PROCEDURE mulvb;          END INTERFACE
  22 INTERFACE madvb;  MODULE PROCEDURE madvb;          END INTERFACE
  23 INTERFACE msbvb;  MODULE PROCEDURE msbvb;          END INTERFACE
  24 INTERFACE mulxb;  MODULE PROCEDURE mulxb;          END INTERFACE
  25 INTERFACE madxb;  MODULE PROCEDURE madxb;          END INTERFACE
  26 INTERFACE msbxb;  MODULE PROCEDURE msbxb;          END INTERFACE
  27
  28 integer, parameter :: i_kind=4
  29 integer, parameter :: r_kind=4
  30 real(r_kind), parameter :: zero=0.0
  31 real(r_kind), parameter :: one=1.0
  32 real(r_kind), parameter :: two=2.0
  33
  34 CONTAINS
  35
  36 SUBROUTINE cad1b(a,m1,mah1,mah2,mirror2)
  37 implicit none
  38 INTEGER(i_kind),  INTENT(IN   ) :: m1,mah1,mah2,mirror2
  39 REAL(r_kind),     INTENT(INOUT) :: a(0:m1-1,-mah1:mah2)
  40 RETURN
  41 ENTRY     csb1b(a,m1,mah1,mah2,mirror2)
  42 END SUBROUTINE cad1b
  43
  44 SUBROUTINE copbt(a,b,m1,m2,mah1,mah2)
  45 implicit none
  46 INTEGER(i_kind),  INTENT(IN   ) :: m1, m2, mah1, mah2
  47 REAL(r_kind),     INTENT(IN   ) :: a(m1,-mah1:mah2)
  48 REAL(r_kind),     INTENT(  OUT) :: b(m2,-mah2:mah1)
  49 RETURN
  50 ENTRY    conbt(a,b,m1,m2,mah1,mah2)
  51 END SUBROUTINE copbt
  52
  53 SUBROUTINE copmb(afull,aband,m1,m2,mah1,mah2)
  54 implicit none
  55 INTEGER(i_kind),                           INTENT(IN   ) :: m1, m2, mah1, mah2
  56 REAL(r_kind),     DIMENSION(m1,m2),        INTENT(IN   ) :: afull
  57 REAL(r_kind),     DIMENSION(m1,-mah1:mah2),INTENT(  OUT) :: aband
  58 RETURN
  59 ENTRY      conmb(afull,aband,m1,m2,mah1,mah2)
  60 END SUBROUTINE copmb
  61
  62 SUBROUTINE copbm(aband,afull,m1,m2,mah1,mah2)
  63 implicit none
  64 INTEGER(i_kind),                           INTENT(IN   ) :: m1, m2, mah1, mah2
  65 REAL(r_kind),     DIMENSION(m1,-mah1:mah2),INTENT(IN   ) :: aband
  66 REAL(r_kind),     DIMENSION(m1,m2),        INTENT(  OUT) :: afull
  67 RETURN
  68 ENTRY      conbm(aband,afull,m1,m2,mah1,mah2)
  69 END SUBROUTINE copbm
  70
  71 SUBROUTINE mulbb(a,b,c,m1,m2,mah1,mah2,mbh1,mbh2,mch1,mch2)
  72 implicit none
  73 INTEGER(i_kind),  INTENT(IN   ) :: m1, m2, mah1, mah2, mbh1, mbh2, mch1, mch2
  74 REAL(r_kind),     INTENT(IN   ) :: a(m1,-mah1:mah2), b(m2,-mbh1:mbh2)
  75 REAL(r_kind),     INTENT(INOUT) :: c(m1,-mch1:mch2)
  76 INTEGER(i_kind)                :: nch1, nch2, j, k, jpk, i1,i2
  77 c=zero
  78 ENTRY      madbb(a,b,c,m1,m2,mah1,mah2,mbh1,mbh2,mch1,mch2)
  79 nch1=mah1+mbh1; nch2=mah2+mbh2
  80 IF(nch1 /= mch1 .OR. nch2 /= mch2)STOP 'In MULBB, dimensions inconsistent'
  81 DO j=-mah1,mah2
  82    DO k=-mbh1,mbh2; jpk=j+k; i1=MAX(1,1-j); i2=MIN(m1,m2-j)
  83       c(i1:i2,jpk)=c(i1:i2,jpk)+a(i1:i2,j)*b(j+i1:j+i2,k)
  84    ENDDO
  85 ENDDO
  86 END SUBROUTINE mulbb
  87
  88 SUBROUTINE MULVB(v1,a,v2, m1,m2,mah1,mah2)
  89 implicit none
  90 INTEGER(i_kind),  INTENT(IN   ) :: m1, m2, mah1, mah2
  91 REAL(r_kind),     INTENT(IN   ) :: v1(m1), a(m1,-mah1:mah2)
  92 REAL(r_kind),     INTENT(  OUT) :: v2(m2)
  93 INTEGER(i_kind)                 :: j, i1,i2
  94 v2=zero
  95 ENTRY    madvb(v1,a,v2, m1,m2,mah1,mah2)
  96 DO j=-mah1,mah2; i1=MAX(1,1-j); i2=MIN(m1,m2-j)
  97    v2(j+i1:j+i2)=v2(j+i1:j+i2)+v1(i1:i2)*a(i1:i2,j)
  98 ENDDO
  99 RETURN
 100 ENTRY    msbvb(v1,a,v2, m1,m2,mah1,mah2)
 101 DO j=-mah1,mah2; i1=MAX(1,1-j); i2=MIN(m1,m2-j)
 102    v2(j+i1:j+i2)=v2(j+i1:j+i2)-v1(i1:i2)*a(i1:i2,j)
 103 ENDDO
 104 END SUBROUTINE mulvb
 105
 106 SUBROUTINE mulxb(v1,a,v2, m1,m2,mah1,mah2,my)
 107 implicit none
 108 INTEGER(i_kind),  INTENT(IN   ) :: m1, m2, mah1, mah2, my
 109 REAL(r_kind),     INTENT(IN   ) :: v1(m1,my), a(m1,-mah1:mah2)
 110 REAL(r_kind),     INTENT(  OUT) :: v2(m2,my)
 111 INTEGER(i_kind)                 :: i,j
 112 v2=zero
 113 ENTRY    madxb(v1,a,v2, m1,m2,mah1,mah2,my)
 114 DO j=-mah1,mah2
 115    DO i=MAX(1,1-j),MIN(m1,m2-j); v2(j+i,:)=v2(j+i,:)+v1(i,:)*a(i,j); ENDDO
 116 ENDDO
 117 RETURN
 118 ENTRY    msbxb(v1,a,v2, m1,m2,mah1,mah2,my)
 119 DO j=-mah1,mah2
 120    DO i=MAX(1,1-j),MIN(m1,m2-j); v2(j+i,:)=v2(j+i,:)-v1(i,:)*a(i,j); ENDDO
 121 ENDDO
 122 END SUBROUTINE mulxb
 123
 124 SUBROUTINE mulyb(v1,a,v2, m1,m2,mah1,mah2,mx)
 125 implicit none
 126 INTEGER(i_kind),  INTENT(IN   ) :: m1, m2, mah1, mah2, mx
 127 REAL(r_kind),     INTENT(IN   ) :: v1(mx,m1), a(m1,-mah1:mah2)
 128 REAL(r_kind),     INTENT(  OUT) :: v2(mx,m2)
 129 INTEGER(i_kind)                 :: i,j
 130 v2=zero
 131 ENTRY    madyb(v1,a,v2, m1,m2,mah1,mah2,mx)
 132 DO j=-mah1,mah2
 133     DO i=MAX(1,1-j),MIN(m1,m2-j)
 134       v2(:,j+i)=v2(:,j+i)+v1(:,i)*a(i,j)
 135     ENDDO
 136 ENDDO
 137 RETURN
 138 ENTRY    msbyb(v1,a,v2, m1,m2,mah1,mah2,mx)
 139  DO j=-mah1,mah2
 140     DO i=MAX(1,1-j),MIN(m1,m2-j)
 141        v2(:,j+i)=v2(:,j+i)-v1(:,i)*a(i,j)
 142     ENDDO
 143  ENDDO
 144 RETURN
 145 END SUBROUTINE mulyb
 146
 147 END MODULE MODULE_pmat2
 148