1! { dg-do compile } 2 subroutine tranx3 (jbeg,jend,kbeg,kend,dlo,den,mflx,zro) 3 parameter(in = 128+5 4 & , jn = 128+5 5 & , kn = 128+5) 6 parameter(ijkn = 128+5) 7 real*8 zro, dqm, dqp, dx3bi (kn) 8 real*8 mflux (ijkn,4), dtwid (ijkn,4), dd (ijkn,4) 9 real*8 mflx (in,jn,kn) 10 real*8 dlo (in,jn,kn), den (in,jn,kn) 11 do 2100 j=jbeg-1,jend 12 dtwid (k,1) = ( 0.5 + q1 ) * ( dlo(i ,j,k-1) 13 3 - ( dx3a(k ) + xi ) * dd (k ,1) ) 14 mflux (k,1) = dtwid (k,1) * ( v3(i ,j,k) - vg3(k) ) * dt 15 if (j.ge.jbeg) then 16 den(i ,j,k) = ( dlo(i ,j,k) * dvl3a(k) 17 1 - etwid (k+1,1) + etwid (k,1) ) * dvl3a i(k) 18 if (kend .eq. ke) mflx(i ,j,ke+1) = mflux (ke+1,1) 19 endif 20 do 2030 k=max(kbeg-2,ks-1),kend+1 21 dqm = (dlo(i ,j,k ) - dlo(i ,j,k-1)) * dx3bi(k ) 22 dqp = (dlo(i ,j,k+1) - dlo(i ,j,k )) * dx3bi(k+1) 23 dd(k,1) = max ( dqm * dqp, zro ) 242030 continue 25 dtwid (k,3) = ( 0.5 + q1 ) * ( dlo(i+2,j,k-1) 26 3 - ( dx3a(k ) + xi ) * deod (k ,3) ) 272100 continue 28 end 29