by **msohail** » Thu Mar 06, 2014 9:24 am

Hi

I am trying to parallised a long long code which has been divided in subroutines. Here I attached a subroutine in which I try to collapse the nested loop but did not use any private directive.

At the end the code should be able copy the global file that other subroutines can use .

SUBROUTINE CALCV

!$omp parallel do collapse (3)

DO K=2,NKM1

DO J=2,NJM1

DO I=2,NIM1

IF (IBLANK(I,J,K).EQ.0) CYCLE ! block

VISE=VIS(I ,J,K)*(1.-FX(I ,J,K))+VIS(I+1,J,K)*FX(I ,J,K)

VISW=VIS(I-1,J,K)*(1.-FX(I-1,J,K))+VIS(I ,J,K)*FX(I-1,J,K)

VISN=VIS(I,J ,K)*(1.-FY(I,J ,K))+VIS(I,J+1,K)*FY(I,J ,K)

VISS=VIS(I,J-1,K)*(1.-FY(I,J-1,K))+VIS(I,J ,K)*FY(I,J-1,K)

VIST=VIS(I,J,K )*(1.-FZ(I,J,K ))+VIS(I,J,K+1)*FZ(I,J,K )

VISB=VIS(I,J,K-1)*(1.-FZ(I,J,K-1))+VIS(I,J,K )*FZ(I,J,K-1)

VOLE=VOL(I ,J,K)*(1.-FX(I ,J,K))+VOL(I+1,J,K)*FX(I ,J,K)

VOLW=VOL(I-1,J,K)*(1.-FX(I-1,J,K))+VOL(I ,J,K)*FX(I-1,J,K)

VOLN=VOL(I,J ,K)*(1.-FY(I,J ,K))+VOL(I,J+1,K)*FY(I,J ,K)

VOLS=VOL(I,J-1,K)*(1.-FY(I,J-1,K))+VOL(I,J ,K)*FY(I,J-1,K)

VOLT=VOL(I,J,K )*(1.-FZ(I,J,K ))+VOL(I,J,K+1)*FZ(I,J,K )

VOLB=VOL(I,J,K-1)*(1.-FZ(I,J,K-1))+VOL(I,J,K )*FZ(I,J,K-1)

!

DENE=DEN(I ,J,K)*(1.-FX(I ,J,K))+DEN(I+1,J,K)*FX(I ,J,K)

DENW=DEN(I-1,J,K)*(1.-FX(I-1,J,K))+DEN(I ,J,K)*FX(I-1,J,K)

DENN=DEN(I,J ,K)*(1.-FY(I,J ,K))+DEN(I,J+1,K)*FY(I,J ,K)

DENS=DEN(I,J-1,K)*(1.-FY(I,J-1,K))+DEN(I,J ,K)*FY(I,J-1,K)

DENT=DEN(I,J,K )*(1.-FZ(I,J,K ))+DEN(I,J,K+1)*FZ(I,J,K )

DENB=DEN(I,J,K-1)*(1.-FZ(I,J,K-1))+DEN(I,J,K )*FZ(I,J,K-1)

Q11E

&=(1.-FX(I ,J,K))*(XX(I ,J,K)**2+XY(I ,J,K)**2+XZ(I ,J,K)**2)

& +FX(I ,J,K) *(XX(I+1,J,K)**2+XY(I+1,J,K)**2+XZ(I+1,J,K)**2)

Q11W

&=(1.-FX(I-1,J,K))*(XX(I-1,J,K)**2+XY(I-1,J,K)**2+XZ(I-1,J,K)**2)

& +FX(I-1,J,K) *(XX(I ,J,K)**2+XY(I ,J,K)**2+XZ(I ,J,K)**2)

Q22N

&=(1.-FY(I,J ,K))*(YX(I,J ,K)**2+YY(I,J ,K)**2+YZ(I,J ,K)**2)

& +FY(I,J ,K)* (YX(I,J+1,K)**2+YY(I,J+1,K)**2+YZ(I,J+1,K)**2)

Q22S

&=(1.-FY(I,J-1,K))*(YX(I,J-1,K)**2+YY(I,J-1,K)**2+YZ(I,J-1,K)**2)

& +FY(I,J-1,K) *(YX(I,J ,K)**2+YY(I,J ,K)**2+YZ(I,J ,K)**2)

Q33T

&=(1.-FZ(I,J,K ))*(ZX(I,J,K )**2+ZY(I,J,K )**2+ZZ(I,J,K )**2)

& +FZ(I,J,K ) *(ZX(I,J,K+1)**2+ZY(I,J,K+1)**2+ZZ(I,J,K+1)**2)

Q33B

&=(1.-FZ(I,J,K-1))*(ZX(I,J,K-1)**2+ZY(I,J,K-1)**2+ZZ(I,J,K-1)**2)

& +FZ(I,J,K-1) *(ZX(I,J,K )**2+ZY(I,J,K )**2+ZZ(I,J,K )**2)

!

DV1(I,J,K)=XY(I,J,K)

DV2(I,J,K)=YY(I,J,K)

DV3(I,J,K)=ZY(I,J,K)

UTNE=0.125*(

& U(I ,J ,K )+U(I ,J+1,K )+U(I+1,J+1,K )+U(I+1,J ,K )

&+U(I ,J ,K+1)+U(I ,J+1,K+1)+U(I+1,J+1,K+1)+U(I+1,J ,K+1))

UTNW=0.125*(

& U(I-1,J ,K )+U(I-1,J+1,K )+U(I ,J+1,K )+U(I ,J ,K )

&+U(I-1,J ,K+1)+U(I-1,J+1,K+1)+U(I ,J+1,K+1)+U(I ,J ,K+1))

UBNE=0.125*(

& U(I ,J ,K-1)+U(I ,J+1,K-1)+U(I+1,J+1,K-1)+U(I+1,J ,K-1)

&+U(I ,J ,K )+U(I ,J+1,K )+U(I+1,J+1,K )+U(I+1,J ,K ))

UBNW=0.125*(

& U(I-1,J ,K-1)+U(I-1,J+1,K-1)+U(I ,J+1,K-1)+U(I ,J ,K-1)

&+U(I-1,J ,K )+U(I-1,J+1,K )+U(I ,J+1,K )+U(I ,J ,K ))

UTSE=0.125*(

& U(I ,J-1,K )+U(I ,J ,K )+U(I+1,J ,K )+U(I+1,J-1,K )

&+U(I ,J-1,K+1)+U(I ,J ,K+1)+U(I+1,J ,K+1)+U(I+1,J-1,K+1))

UTSW=0.125*(

& U(I-1,J-1,K )+U(I-1,J ,K )+U(I ,J ,K )+U(I ,J-1,K )

&+U(I-1,J-1,K+1)+U(I-1,J ,K+1)+U(I ,J ,K+1)+U(I ,J-1,K+1))

UBSE=0.125*(

& U(I ,J-1,K-1)+U(I ,J ,K-1)+U(I+1,J ,K-1)+U(I+1,J-1,K-1)

&+U(I ,J-1,K )+U(I ,J ,K )+U(I+1,J ,K )+U(I+1,J-1,K ))

UBSW=0.125*(

& U(I-1,J-1,K-1)+U(I-1,J ,K-1)+U(I ,J ,K-1)+U(I ,J-1,K-1)

&+U(I-1,J-1,K )+U(I-1,J ,K )+U(I ,J ,K )+U(I ,J-1,K ))

WTNE=0.125*(

& W(I ,J ,K )+W(I ,J+1,K )+W(I+1,J+1,K )+W(I+1,J ,K )

&+W(I ,J ,K+1)+W(I ,J+1,K+1)+W(I+1,J+1,K+1)+W(I+1,J ,K+1))

WTNW=0.125*(

& W(I-1,J ,K )+W(I-1,J+1,K )+W(I ,J+1,K )+W(I ,J ,K )

&+W(I-1,J ,K+1)+W(I-1,J+1,K+1)+W(I ,J+1,K+1)+W(I ,J ,K+1))

WBNE=0.125*(

& W(I ,J ,K-1)+W(I ,J+1,K-1)+W(I+1,J+1,K-1)+W(I+1,J ,K-1)

&+W(I ,J ,K )+W(I ,J+1,K )+W(I+1,J+1,K )+W(I+1,J ,K ))

WBNW=0.125*(

& W(I-1,J ,K-1)+W(I-1,J+1,K-1)+W(I ,J+1,K-1)+W(I ,J ,K-1)

&+W(I-1,J ,K )+W(I-1,J+1,K )+W(I ,J+1,K )+W(I ,J ,K ))

WTSE=0.125*(

& W(I ,J-1,K )+W(I ,J ,K )+W(I+1,J ,K )+W(I+1,J-1,K )

&+W(I ,J-1,K+1)+W(I ,J ,K+1)+W(I+1,J ,K+1)+W(I+1,J-1,K+1))

WTSW=0.125*(

& W(I-1,J-1,K )+W(I-1,J ,K )+W(I ,J ,K )+W(I ,J-1,K )

&+W(I-1,J-1,K+1)+W(I-1,J ,K+1)+W(I ,J ,K+1)+W(I ,J-1,K+1))

WBSE=0.125*(

& W(I ,J-1,K-1)+W(I ,J ,K-1)+W(I+1,J ,K-1)+W(I+1,J-1,K-1)

&+W(I ,J-1,K )+W(I ,J ,K )+W(I+1,J ,K )+W(I+1,J-1,K ))

WBSW=0.125*(

& W(I-1,J-1,K-1)+W(I-1,J ,K-1)+W(I ,J ,K-1)+W(I ,J-1,K-1)

&+W(I-1,J-1,K )+W(I-1,J ,K )+W(I ,J ,K )+W(I ,J-1,K ))

XXYYE=(1.-FX(I ,J,K))*XX(I ,J,K)*YY(I ,J,K)

& +FX(I ,J,K) *XX(I+1,J,K)*YY(I+1,J,K)

XXYYW=(1.-FX(I-1,J,K))*XX(I-1,J,K)*YY(I-1,J,K)

& +FX(I-1,J,K) *XX(I ,J,K)*YY(I ,J,K)

SC2=VISE/VOLE*( (UTNE+UBNE-UTSE-UBSE)*XXYYE )

& -VISW/VOLW*( (UTNW+UBNW-UTSW-UBSW)*XXYYW )

SC2=0.5*SC2

YYYYN=(1.-FY(I,J ,K))*YY(I,J ,K)*YY(I,J ,K)

& +FY(I,J ,K) *YY(I,J+1,K)*YY(I,J+1,K)

YYYYS=(1.-FY(I,J-1,K))*YY(I,J-1,K)*YY(I,J-1,K)

& +FY(I,J-1,K) *YY(I,J ,K)*YY(I,J ,K)

SC5=VISN/VOLN*( (V(I,J+1,K)-V(I,J,K))*YYYYN )

& -VISS/VOLS*( (V(I,J,K)-V(I,J-1,K))*YYYYS )

ZZYYT=(1.-FZ(I,J,K ))*ZZ(I,J,K )*YY(I,J,K )

& +FZ(I,J,K ) *ZZ(I,J,K+1)*YY(I,J,K+1)

ZZYYB=(1.-FZ(I,J,K-1))*ZZ(I,J,K-1)*YY(I,J,K-1)

& +FZ(I,J,K-1) *ZZ(I,J,K )*YY(I,J,K )

SC8=VIST/VOLT*( (WTNE+WTNW-WTSE-WTSW)*ZZYYT )

& -VISB/VOLB*( (WBNE+WBNW-WBSE-WBSW)*ZZYYB )

SC8=0.5*SC8

SU(I,J,K)=SC2+SC5+SC8 ! stress

PRESE=P(I ,J,K)*(1.-FX(I ,J,K))+P(I+1,J,K)*FX(I ,J,K)

PRESW=P(I-1,J,K)*(1.-FX(I-1,J,K))+P(I ,J,K)*FX(I-1,J,K)

PRESN=P(I,J ,K)*(1.-FY(I,J ,K))+P(I,J+1,K)*FY(I,J ,K)

PRESS=P(I,J-1,K)*(1.-FY(I,J-1,K))+P(I,J ,K)*FY(I,J-1,K)

PREST=P(I,J,K )*(1.-FZ(I,J,K ))+P(I,J,K+1)*FZ(I,J,K )

PRESB=P(I,J,K-1)*(1.-FZ(I,J,K-1))+P(I,J,K )*FZ(I,J,K-1)

SP(I,J,K)=0.

SU(I,J,K)=SU(I,J,K) ! stress

& +DV1(I,J,K)*(PRESW-PRESE) ! pressure

& +DV2(I,J,K)*(PRESS-PRESN)

& +DV3(I,J,K)*(PRESB-PREST)

& -(9.8*9)/(5.6*5.6)*(DEN(I,J,K)-1) !MAHWISH GRAVITY FORCES

& +((AF+BT)*DENO(I,J,K)*VO(I,J,K)-BT*VM(I,J,K))*VOL(I,J,K)/DELT ! MAHWISH DENSITY transient

END DO

END DO

END DO

!$OMP END PARALLEL DO

!$omp parallel do collapse(3)

DO I=1,NI

DO J=1,NJ

DO K=1,NK

Q(I,J,K)=V(I,J,K) ( update the variable )

END DO

END DO

END DO

!$OMP END PARALLEL DO

c CALL UMIST(Q)

CALL MODV (call boundary condition)

RESORV=0.

!$omp parallel do collapse (3)

DO K=2,NKM1

DO J=2,NJM1

DO I=2,NIM1

IF (IBLANK(I,J,K).EQ.0) CYCLE ! Block ( This is due to the presence of block )

AC=AE(I,J,K)+AW(I,J,K)+AN(I,J,K)+AS(I,J,K)+AT(I,J,K)+AB(I,J,K)

AP(I,J,K)=AC-SP(I,J,K)

& +AF*DEN(I,J,K)*VOL(I,J,K)/DELT ! MAHWISH DENSITY transient

RESOR=AE(I,J,K)*V(I+1,J,K)+AW(I,J,K)*V(I-1,J,K)

& +AN(I,J,K)*V(I,J+1,K)+AS(I,J,K)*V(I,J-1,K)

& +AT(I,J,K)*V(I,J,K+1)+AB(I,J,K)*V(I,J,K-1)+SU(I,J,K)

& -AP(I,J,K)*V(I,J,K)

IF(SP(I,J,K).EQ.-GREAT) RESOR=0.

RESORV=RESORV+ABS(RESOR)

C UNDERRELAX

AP(I,J,K)=AP(I,J,K)/URFV

SU(I,J,K)=SU(I,J,K)+(1.-URFV)*AP(I,J,K)*V(I,J,K)

C For SIMPLE use the following code: (and, comment out code for SIMPLEC below)

c DV1(I,J,K)=DV1(I,J,K)/AP(I,J,K)

c DV2(I,J,K)=DV2(I,J,K)/AP(I,J,K)

c DV3(I,J,K)=DV3(I,J,K)/AP(I,J,K)

C For SIMPLEC use the following code: (and, comment out code for SIMPLE above)

DV1(I,J,K)=DV1(I,J,K)/(AP(I,J,K)-AC)

DV2(I,J,K)=DV2(I,J,K)/(AP(I,J,K)-AC)

DV3(I,J,K)=DV3(I,J,K)/(AP(I,J,K)-AC)

END DO

END DO

END DO

!$OMP END PARALLEL DO

CALL SIP3D(V,RESORV,FRACV,NSWPV,NVMIN)

RETURN

END