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