Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Subroutine give me very strange error

Status
Not open for further replies.

drudox

Programmer
Aug 23, 2020
1
0
0
IT
Hello I develop this subroutine in order to compute fluid dynamic quantities (using conditional statistic)

this is the subroutine :

Code:
SUBROUTINE alpha_avg(ie,je,ke,ngen,fvvel,lp_gen,lm_gen,dx_gen,enphampl,delts,ratstr,&
                     vorv,vorstr,velc)

use nrtype; use gencoms; use snf_coms; use snfproc; use eigen

implicit none

integer:: i,j,k,w,ie,je,ke,l
integer,parameter::alignbins=100
!integer,parameter::npdim=3
real, dimension(npdim+1)::eigvec
real, dimension(npdim)::vorv,wcos,delts,velc,omega
real               ::alpha,alpha1,alpha2,alpha3
!real,dimension(alignbins)::alpha_avg,alpha1_avg,alpha2_avg,alpha3_avg
real,dimension(alignbins)::alpha_m,alpha1_avg,alpha2_avg,alpha3_avg
real               ::s11,s22,s33,s12,s13,s23
real               ::omx,omy,omz
real               ::ratstr(3,3)
real               ::dq1d2,dq1d3,dq2d1,dq2d3,dq3d1,dq3d2
real               ::q1ru,q1lu,q1cu,q1rd,q1ld,q1cd
real               ::q2ru,q2lu,q2cu,q2rd,q2ld,q2cd
real               ::q2ur,q2dr,q2cr,q2ul,q2dl,q2cl
real               ::q3ur,q3dr,q3cr,q3ul,q3dl,q3cl
real,dimension(npdim),intent(in)::ngen
real,dimension(npdim,0:ngen(1),0:ngen(2),0:ngen(3)),intent(in)::fvvel
real,dimension(npdim)::dx_gen
integer,dimension(npdim,maxval(ngen)),intent(in)::lp_gen,lm_gen
integer            ::iem,jem,kem,iep,jep,kep
integer::nrank(3)
!-------------------------------------------------------------------------------------------------------------
alpha=0.
alpha1=0.
alpha2=0.
alpha3=0.

 DO i=1,256
  DO j=1,256
   DO k=1,256

   ! lm_gen create the value :  i-1 , j-1 , k+1 , i+1 .. j+1 .. k+1  
       iem=lm_gen(1,i)
       jem=lm_gen(2,j)
       kem=lm_gen(3,k)
       iep=lp_gen(1,i)
       jep=lp_gen(2,j)
       kep=lp_gen(3,k)

      ratstr=0.

      ! THE NORMAL STRESSES s11,s22,s33

       s11=(fvvel(1,i,j,k)-fvvel(1,iem,j,k))/dx_gen(1)
       s22=(fvvel(2,i,j,k)-fvvel(2,i,jem,k))/dx_gen(2)
       s33=(fvvel(3,i,j,k)-fvvel(3,i,j,kem))/dx_gen(3)
      !  THE STRESS s12 AND VORTICITY OMZ

      q1ru=(fvvel(1,i,j,k)+fvvel(1,i,jep,k))/2.
      q1lu=(fvvel(1,iem,j,k)+fvvel(1,iem,jep,k))/2.
      q1cu=(q1ru+q1lu)/2.
      q1rd=(fvvel(1,i,j,k)+fvvel(1,i,jem,k))/2.
      q1ld=(fvvel(1,iem,j,k)+fvvel(1,iem,jem,k))/2.
      q1cd=(q1rd+q1ld)/2.

      dq1d2=(q1cu-q1cd)/dx_gen(2)

      q2ur=(fvvel(2,i,j,k)+fvvel(2,iep,j,k))/2.
      q2dr=(fvvel(2,i,jem,k)+fvvel(2,iep,jem,k))/2.
      q2cr=(q2ur+q2dr)/2.
      q2ul=(fvvel(2,i,j,k)+fvvel(2,iem,j,k))/2.
      q2dl=(fvvel(2,i,jem,k)+fvvel(2,iem,jem,k))/2.
      q2cl=(q2ul+q2dl)/2.

      dq2d1=(q2cr-q2cl)/dx_gen(1)

      s12=0.5*(dq1d2+dq2d1)
      omz=dq2d1-dq1d2

! THE STRESS s13 AND VORTICITY OMY

    q1ru=(fvvel(1,i,j,k)+fvvel(1,i,j,kep))/2.
    q1lu=(fvvel(1,iem,j,k)+fvvel(1,iem,j,kep))/2.
    q1cu=(q1ru+q1lu)/2.
    q1rd=(fvvel(1,i,j,k)+fvvel(1,i,e,kem))/2.
    q1ld=(fvvel(1,iem,j,ke)+fvvel(1,iem,jekem))/2.
    q1cd=(q1rd+q1ld)/2.
    dq1d3=(q1cu-q1cd)/dx_gen(3)

    q3ur=(fvvel(3,i,j,k)+fvvel(3,iep,j,k))/2.
    q3dr=(fvvel(3,i,j,kem)+fvvel(3,iep,j,kem))/2.
    q3cr=(q3ur+q3dr)/2.
    q3ul=(fvvel(3,i,j,k)+fvvel(3,iem,je,ke))/2.
    q3dl=(fvvel(3,i,j,kem)+fvvel(3,iem,je,kem))/2.
    q3cl=(q3ul+q3dl)/2.

    dq3d1=(q3cr-q3cl)/dx_gen(1)

    s13=0.5*(dq1d3+dq3d1)
    omy=dq1d3-dq3d1

 ! THE STRESS s23 AND VORTICITY OMX

     q2ru=(fvvel(2,i,j,k)+fvvel(1,i,j,kep))/2.
     q2lu=(fvvel(2,i,jem,k)+fvvel(2,ie,j,kep))/2.
     q2cu=(q2ru+q2lu)/2.
     q2rd=(fvvel(2,i,j,k)+fvvel(2,i,j,kem))/2.
     q2ld=(fvvel(2,i,jem,k)+fvvel(2,i,jem,kem))/2.
     q2cd=(q2rd+q2ld)/2.

     dq2d3=(q2cu-q2cd)/dx_gen(3)

     q3ur=(fvvel(3,i,j,k)+fvvel(3,i,jep,k))/2.
     q3dr=(fvvel(3,i,j,kem)+fvvel(3,i,jep,kem))/2.
     q3cr=(q3ur+q3dr)/2.
     q3ul=(fvvel(3,i,j,k)+fvvel(3,ie,jem,k))/2.
     q3dl=(fvvel(3,i,j,kem)+fvvel(3,i,jem,kem))/2.
     q3cl=(q3ul+q3dl)/2.

     dq3d2=(q3cr-q3cl)/dx_gen(2)

     s23=0.5*(dq2d3+dq3d2)
     omx=dq3d2-dq2d3
     ratstr(1,1)=s11
      ratstr(1,2)=s12
      ratstr(1,3)=s13

      ratstr(2,1)=s12
      ratstr(2,2)=s22
      ratstr(2,3)=s23

      ratstr(3,1)=s13
      ratstr(3,2)=s23
      ratstr(3,3)=s33


      omega(1)=omx
      omega(2)=omy
      omega(3)=omz


      
      vorv=omega      !



! now compute also the eigenvalues of the rate of strain tensor ratstr

      call tred2(ratstr,delt,deps)
      call tqli(delt,deps,ratstr)

! delt are the eigenvalues which are NOT sorted yet

    call sort_delt(delt,delts,nrank)   !delt comes in delts comes out

    DO w=1,npdim

        eigvec(1:3)=ratstr(1:3,nrank(w))
        eigvec(npdim+1)=sqrt(dot_product(eigvec(1:3),eigvec(1:3)))
        wcos(w) = abs(dot_product(vorv(1:3),eigvec(1:3))/(sqrt(dot_product(vorv(1:3),vorv(1:3)))* eigvec(npdim+1)))


       eigvec(npdim+1)))

        alpha1 = alpha1 + wcos(1)**2 * delts(1)
        alpha2 = alpha2 + wcos(2)**2 * delts(2)
        alpha3 = alpha3 + wcos(3)**2 * delts(3)

        alpha = alpha1 + alpha2 + alpha3

      DO l=1,alignbins

       IF(wcos(1) > real(w-1)/real(alignbins) .and. wcos(1) <= real(w)/real(alignbins))THEN

            alpha1_avg(l) = alpha1_avg(l) + alpha1
            alpha2_avg(l) = alpha2_avg(l) + alpha2
            alpha3_avg(l) = alpha3_avg(l) + alpha3
            alpha_m(l)    = alpha1 + alpha2 + alpha3

        END IF
        EXIT

     END DO
    END DO
   END DO
  END DO
 END DO

alpha_mean = alpha/ (256*256*256)

alpha_m(1:alignbins) /alpha_mean/ (256*256*256)
alpha1_avg(1:alignbins) /alpha_mean/ (256*256*256)
alpha2_avg(1:alignbins) /alpha_mean/ (256*256*256)
alpha3_avg(1:alignbins) /alpha_mean/ (256*256*256)




END SUBROUTINE

this during compilation (ifort 2018) give me this error :

Code:
/opt/intelxe2018/bin/ifort -w -pg -r8 -O2 -c snfout.f90
snfout.f90(4882): error #5082: Syntax error, found END-OF-STATEMENT when expecting one of: => = . [ % ( :
i!DO l=1,alignbins 
-------------------^
snfout.f90(4883): error #5082: Syntax error, found '/' when expecting one of: => = . [ % (
      alpha_m(1:alignbins) /alpha_mean
---------------------------^
snfout.f90(4884): error #5082: Syntax error, found '/' when expecting one of: => = . [ % (
	alpha1_avg(1:alignbins) /alpha_mean
--------------------------------^
snfout.f90(4885): error #5082: Syntax error, found '/' when expecting one of: => = . [ % (
	alpha2_avg(1:alignbins) /alpha_mean
--------------------------------^
snfout.f90(4886): error #5082: Syntax error, found '/' when expecting one of: => = . [ % (
      alpha3_avg(1:alignbins) /alpha_mean
------------------------------^
snfout.f90(4882): error #6236: A specification statement cannot appear in the executable section.
i!DO l=1,alignbins 
^
snfout.f90(4877): error #6404: This name does not have a type, and must have an explicit type.   [ALPHA_MEAN]
alpha_mean = alpha/ (256*256*256)
^
snfout.f90(4883): error #6793: The POINTER attribute is required.   [ALPHA_M]
      alpha_m(1:alignbins) /alpha_mean
------^
snfout.f90(4884): error #6793: The POINTER attribute is required.   [ALPHA1_AVG]
	alpha1_avg(1:alignbins) /alpha_mean
--------^
snfout.f90(4885): error #6793: The POINTER attribute is required.   [ALPHA2_AVG]
	alpha2_avg(1:alignbins) /alpha_mean
--------^
snfout.f90(4886): error #6793: The POINTER attribute is required.   [ALPHA3_AVG]
      alpha3_avg(1:alignbins) /alpha_mean
------^
compilation aborted for snfout.f90 (code 1)
makefile:102: recipe for target 'snfout.o' failed
make: *** [snfout.o] Error 1
------------------------------------------------------------------------------------------------------------------

Might somebody give me an help ?? thanks a lot
 
Can you have a look at the last 4 statements before the end? What exactly do you want them to do
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top