Fortran common block and Modules

Fortran common block and Modules

Hello sir,

I am converting one of the old code F77 in F90. I am encountering a huge number of errors, especially in common block and module.

I tried it in 3 ways by reading the forum information

1) I tried to make a static library of module object files but still, I was getting errors that showed that the static library is not linked properly with source files.

2)  I tried to execute the FORTRAN files of modules in source and it also didn't work.

3) I tried to keep the common blocks as it is and still it doesn't work at all.

I am giving a sample bit of one program:-

one file from the source files:-

 

SUBROUTINE arco(i,flow,*)

use  param1
use  parampch 
use  array2
use  flag
use  CONSTNT
use  factlim
use  array1
use  options1

! Code converted using TO_F90 by Alan Miller
! Date: 2017-06-01  Time: 21:33:28
IMPLICIT NONE
INTEGER, INTENT(IN OUT)                  :: i
REAL, INTENT(IN)                         :: flow
!integer:: nsubr,ji2,kopt,ji1
!real:: rholim,dp(5000),area(5000)

!INTENT(IN)                               :: *

!=====================================================================
!=====================================================================
!    <NAME>
!     ARCO

!    <DESCRIPTION>
!     THIS SUBROUTINE CALCULATES THE FLOW VARIABLES ACROSS
!     AN ABRUPT AREA CHANGE.

!=====================================================================
!=====================================================================

 

INTEGER :: ik

REAL    :: rho1, fflow, beta2, rkf, phsq, phisq

 

IF(nsubr == 1)THEN
  rho(i,ji2) = rho(i-1,ji2)
  fflow      = flow
ELSE
  fflow      = rho(i-1,ji2)*u(i-1,ji2)*area(i-1)
  rho(i,ji2) = rho(i,ji1)
END IF

DO  ik=1,500
  
  u(i,ji2)   = fflow/area(i)/rho(i,ji2)
!------EXPANSION---------------------
  IF(area(i-1) < area(i))THEN
    beta2 = area(i-1)/area(i)
    rkf = (1.- beta2)**2
  ELSE
!------CONTRACTION-------------------
    beta2 = area(i)/area(i-1)
    rkf = 0.5*(1.-beta2 )/beta2**2
  END IF
!         Function PHISQ requires two parameters, assume JI2 is
!         the second parameter
  phsq = phisq(i-1,ji2)
  rkf = rkf*phsq*rho(i-1,ji2)/rhof(i-1,ji2)
  rkf = rkf * kopt
  p(i,ji2)    = p(i-1,ji2)+2.*fflow*((1.-rkf/2.)*u(i-1,ji2)-  &
      u(i,ji2))/(area(i-1)+area(i))
  h(i,ji2)    = h(i-1,ji2) + 0.5*(u(i-1,ji2)**2-u(i,ji2)**2)
  CALL stprop(p(i,ji2),h(i,ji2),i,rho1)
  
  IF( ik > 1 .AND. ABS(rho1-rho(i,ji2)) < rholim)THEN
    GO TO 200
  ELSE
    rho(i,ji2) = rho1
  END IF
END DO

200   CONTINUE
rho(i,ji2) = rho1
alfa(i,ji2)= xqu(i,ji2)*rho1/rhog(i,ji2)
alfa(i,ji2)= MAX(0.,alfa(i,ji2))
dp(i-1)    = p(i,ji2) - p(i-1,ji2)
RETURN

300   CONTINUE
RETURN 1

END SUBROUTINE arco

The modules used in the program are as follows

 

Module array1
use param1
use parampch
INTEGER :: ncode(nodemx), ncorsb(nodemx)
Real :: area(nodemx),   di(nodemx),     dx(nodemx),                &
    eqdiam(nodemx), v(nodemx),      rk(nodemx),                      &
    ck(nodemx),ruff(nodemx),dp(nodemx),vstar(nodemx),rstar(nodemx),  &
    sth(nodemx),sq(nodemx), nb(nodemx), &
    farray(nodemx)
real::burnpow
Real:: sumdxch(nodemx,nchanx) , fa(nodemx,nchanx)
integer:: ji1,ji2

End Module array1

Param1 and parampch modules have the variables "nodemx ", "nchanx" declared as parameters.

1 post / 0 new
Last post
For more complete information about compiler optimizations, see our Optimization Notice.