LGNW2G.inc
References to this file elsewhere.
1 SUBROUTINE LGNW2G
2 I(MEND1,NEND1,JEND1,MNWAV,IMAX,JMAX,JMAXHF,KMAX,IPNM,PNM,QDAT,
3 O GDAT ,
4 W GWRK)
5 C
6 DIMENSION QDAT(2,KMAX,MNWAV) ,PNM (MNWAV,JMAXHF)
7 DIMENSION GDAT(IMAX,JMAX,KMAX),GWRK(IMAX,2)
8 DIMENSION GDATW(KMAX,IMAX,2)
9 DIMENSION QDATW(KMAX,3,MNWAV)
10 C
11 c*nec MNWAV=MNWAV
12 CALL RESET(GDAT,IMAX*JMAX*KMAX)
13
14 ! Rearrange QDAT data so that we can collapse the inner loop
15 ! over 2 chunks of length KMAX.
16 !CDIR NOVECTOR
17 DO K=1,KMAX
18 !CDIR NODEP
19 DO L=1,MNWAV
20 QDATW(K,1,L)=QDAT(1,K,L)
21 QDATW(K,2,L)=QDAT(2,K,L)
22 ENDDO
23 ENDDO
24
25 C
26 DO 100 J=1,JMAXHF
27 CALL RESET(GDATW,KMAX*IMAX*2)
28 JM= J
29 JP=JMAX+1-J
30 JMC=1
31 JPC=2
32 IF (JM .EQ. JP) JPC=JMC
33 L=0
34 DO 120 M=1,MEND1
35 NMAX=MIN(JEND1+1-M,NEND1)
36 DO 140 N=1,NMAX,2
37 !CDIR NOASSUME
38 DO 140 K=1,KMAX*2
39 GDATW(K,2*M-1,JMC)=GDATW(K,2*M-1,JMC)+QDATW(K,1,L+N)*PNM(L+N,J)
40 C-COLL GDATW(K,2*M ,JMC)=GDATW(K,2*M ,JMC)+QDATW(K,2,L+N)*PNM(L+N,J)
41 140 CONTINUE
42 DO 160 N=2,NMAX,2
43 !CDIR NOASSUME
44 DO 160 K=1,KMAX*2
45 GDATW(K,2*M-1,JPC)=GDATW(K,2*M-1,JPC)+QDATW(K,1,L+N)*PNM(L+N,J)
46 C-COLL GDATW(K,2*M ,JPC)=GDATW(K,2*M ,JPC)+QDATW(K,2,L+N)*PNM(L+N,J)
47 160 CONTINUE
48 L=L+NMAX
49 120 CONTINUE
50
51 C
52 DO K=1,KMAX
53 !CDIR NODEP
54 DO M=1,2*MEND1
55 GDAT(M,JM,K)=GDATW(K,M,JMC)
56 GDAT(M,JP,K)=GDATW(K,M,JPC)
57 ENDDO
58 ENDDO
59 C
60 IF(MOD(JMAX,2).EQ.1.AND.J.EQ.JMAXHF) GO TO 100
61 DO 200 K=1,KMAX
62 DO 200 M=1,MEND1*2
63 IF(IPNM.EQ.1) THEN
64 GWRKM1=GDAT(M,JM,K)+GDAT(M,JP,K)
65 GWRKM2=GDAT(M,JM,K)-GDAT(M,JP,K)
66 ELSE
67 GWRKM1=GDAT(M,JP,K)+GDAT(M,JM,K)
68 GWRKM2=GDAT(M,JP,K)-GDAT(M,JM,K)
69 END IF
70 GDAT(M,JM,K)=GWRKM1
71 GDAT(M,JP,K)=GWRKM2
72 200 CONTINUE
73 C
74 100 CONTINUE
75 C
76 RETURN
77 END SUBROUTINE LGNW2G
78