HOW TO PASS ARRAY ELEMENT FORM A SUBROUTINE TO MAIN FUNCTION

[FZK]

HI GUYS.

I WANT TO TRANSFER EACH ELEMENTS OF AN ARRAY (WHICH IS DECLARED IN ONE SUBROUTINE)TO MAIN FUNCTION USING COMMON BLOCK TECHNIQUE.
WHEN I AM DOING SO I GO ALWAYS A CONSTANT VALUE IN THE ARRAY IN THE MAIN FUNCTION.

SO IF ANYBODY HAS SOME GUIDANCE THEN PLEASE GUIDE ME

 

[FJacq]

Show us your code please (if possible a simplified working version) !

Your explanation is not at all clear. In particular, I don't know what is a main function : I know what is a main program and what is function but not the mixture of both.

In addition, I don't know how you are using the common technique you mention (and I am a little bit curious...)

 

[FZK]

THANKS A LOT FOR YOUR REPLY...HERE I AM SENDING ONLY FEW LINES OF OUR CODE AS THE CODE WAS VERY BIG....I ONLY WANTS TO TRANSFER BPARZ(K) ARRAY IN THE CODE TO ANOTHER SUBROUTINE THROUGH COMMON BLOCK TECHNIQUE......ALSO SUGGEST ME HOW I CAN TRANSFER TWO DIMENSIONAL ARRAY (BPARZ(I,K)), THROUGH COMMON BLOCK TECHNIQUE....
DO 2 K=1,NZ
PSUMNB=0
QSUMNB=0

DO 44 J=1,NSPRD
HP(J)=HC(J)
A1=1./BPAR(J)
HC(J)=BFLD(K)*A1
A1=G0I*A1
DO 45 NB=1,NEPHAS
PSUMSC=0
QSUMSC=0
DO 42 I=1,NPART
HVA=GA(I,J,NB)*A1
HV=HVA*WCAVG-HP(J)
HV=HVA*WC(1)-HP(J)
UP(I)=QS(I,J,NB)*HV-HVA*VISUM(K-1,NB)
& +CSC*HVA*BPAR(J)*QS(I,J,NB)
VP(I)=-PS(I,J,NB)*HV+HVA*VRSUM(K-1,NB)
& -CSC*HVA*BPAR(J)*PS(I,J,NB)
PP(I)=PS(I,J,NB)+HZ*UP(I)
QP(I)=QS(I,J,NB)+HZ*VP(I)
PSUMSC=PSUMSC+PP(I)
QSUMSC=QSUMSC+QP(I)
42 CONTINUE
PAV=PSUMSC/NPART
QAV=QSUMSC/NPART
DO 43 I=1,NPART HVA=SQRT(CC1(J)+PP(I)*PP(I)+QP(I)*QP(I))*A1
HV=HVA*WCAVG-HC(J)
C HV=HVA*WC(1)-HC(J)
UC=QP(I)*HV-HVA*VISUM(K,NB)
& +CSC*HVA*BPAR(J)*(QS(I,J,NB)-QAV)
VC=-PP(I)*HV+HVA*VRSUM(K,NB)
& -CSC*HVA*BPAR(J)*(PS(I,J,NB)-PAV)
PS(I,J,NB)=MAX(-2.D1,MIN(PS(I,J,NB)+HZI2*(UP(I)+UC),2.D1))
QS(I,J,NB)=MAX(-2.D1,MIN(QS(I,J,NB)+HZI2*(VP(I)+VC),2.D1))
C if(ABS(PS(I,J,NB)).EQ.1.D10.OR.ABS(QS(I,J,NB)).EQ.1.D10)
C & write(*,*) I,UC,QP(I),HV,HVA,VISUM(K,NB),CSC,BPAR(J),QAV
GA(I,J,NB)=SQRT(
& CC1(J)+PS(I,J,NB)*PS(I,J,NB)+QS(I,J,NB)*QS(I,J,NB))
C GAZ(K)=GA(I,J,NB)
BPER(I,J,NB)=ABS(SQRT((PS(I,J,NB)*PS(I,J,NB))+
& (QS(I,J,NB)*QS(I,J,NB))))
BPARZ(K)=SQRT(1.-(BPER(I,J,NB)*BPER(I,J,NB))-
& 1./(GA(I,J,NB)*GA(I,J,NB)))
C WRITE(*,*)K,I,BPARZ(K)
PSUMNB(NB)=PSUMNB(NB)+PS(I,J,NB)*FACCON(J)
QSUMNB(NB)=QSUMNB(NB)+QS(I,J,NB)*FACCON(J)
43 CONTINUE
45 CONTINUE
C!$omp end paralleldo
44 CONTINUE
C WRITE(*,*) K,BPARZ(K)
C
DO 53 II=1,IIMAX
WCFAC=WC(II)/(NPART*NEPHAS)*CONFAC(K,II)
PSUM=0.
QSUM=0.
DO 55 NB=1,NEPHAS
RCOS=REAL(EXPM(II,NB))
RSIN=AIMAG(EXPM(II,NB))
PSUM=PSUM+(PSUMNB(NB)*RCOS+RSIN*QSUMNB(NB))
QSUM=QSUM+(QSUMNB(NB)*RCOS-PSUMNB(NB)*RSIN)
55 CONTINUE
RCOS=REAL(EXPT(K,II))
RSIN=AIMAG(EXPT(K,II))
RHSR(K,II)=(RCOS*PSUM+RSIN*QSUM)*WCFAC
RHSI(K,II)=(-RSIN*PSUM+RCOS*QSUM)*WCFAC
UVPOT=U*VFAC(II)*POT(K,II)/2.
R(K,II)=CMPLX(RHSR(K,II),RHSI(K,II))

C TAKE CARE: VO(NZ+1) MUST BE DEFINED BEFORE

R(K,II)=BB(II)*(VO(K+1,II)+VO(K-1,II))-U*VFAC(II)*R(K,II)
& +VO(K,II)*(1.-2.*BB(II)+UVPOT)
DIAG(K,II)=1.+BB(II)*2.-UVPOT
53 CONTINUE
C
C electron output if desired
IF(MOD(IST,NEOUT).EQ.0.) THEN
ETAZ=0.
WRITE(9,*)
WRITE(9,*) "## Z/mm= ",ZZ(K)
DO 90 NB=1,NEPHAS
WRITE(9,*)
WRITE(9,*)
WRITE(9,*)"## Phase step ",NB
DO 91 J=1,NSPRD
DO 92 I=1,NPART
ETAZ=ETAZ+GA(I,J,NB)*WE(J)
WKIN=(GA(I,J,NB)-1)/(G0-1)
WRITE(9,*) ATAN2(QS(I,J,NB),PS(I,J,NB)),WKIN,ZZ(K)
CDUMMY=RBEAMZ(K)+WKIN*CEXP(U*ATAN2(QS(I,J,NB),PS(I,J,NB)))
C WRITE(9,*) ATAN2(REAL(CDUMMY),AIMAG(CDUMMY)),ABS(CDUMMY),ZZ(K)
92 CONTINUE
91 CONTINUE
90 CONTINUE
ETAZ=(G0-ETAZ/(NPART*NEPHAS))/(G0-1.)
WRITE(99,*) ZZ(K),ETAZ,BIN(K),RBEAMZ(K)
ENDIF
IF(T_ELECD.GE.0..AND.TACT.GE.T_ELECD.AND.ZZ(K).EQ.Z_ELECD) THEN
BPERP=0.
DO 93 NB=1,NEPHAS
DO 94 J=1,NSPRD
DO 95 I=1,NPART
BPERP(I,J,NB)=
& SQRT(1.-BPAR(J)*BPAR(J)-1./(GA(I,J,NB)*GA(I,J,NB)))
95 CONTINUE
94 CONTINUE
93 CONTINUE
ENDIF
C
2 CONTINUE

 

[FJacq]

Do you want something like that ?

PROGRAM main
  IMPLICIT NONE
  REAL b
  COMMON/c/ b(10,20)
  CALL a()
  WRITE(*,*) b(2,3) ! should print out 5
END PROGRAM
  
SUBROUTINE a()
  IMPLICIT NONE
  REAL b
  INTEGER i,j
  COMMON/c/ b(10,20)
  DO i=1,10
    DO j=1,20
      b(i,j)=i+j
    ENDDO
  ENDDO
END SUBROUTINE

Notice that common structures tend to be replaced by modules in modern FORTRAN. The arrays declared in a module may be allocatable, i.e their size fixed dynamically :

MODULE c

  IMPLICIT NONE
  REAL,ALLOCATABLE :: b(:,:)
  
 CONTAINS
 
  SUBROUTINE a(n1,n2)
    INTEGER,INTENT(in) :: n1,n2
    INTEGER :: i,j
    IF(.NOT.ALLOCATED(b)) ALLOCATE(b(n1,n2))
    DO i=1,n1
      DO j=1,n2
        b(i,j)=i+j
      ENDDO
    ENDDO
  END SUBROUTINE
  
END MODULE

PROGRAM main
  USE c
  IMPLICIT NONE
  CALL a(10,20)
  WRITE(*,*) b(2,3) ! should print out 5
END PROGRAM

 

[FZK]

yes i need this..thanks a lot