WEIHT2.inc

1       SUBROUTINE WEIHT2                                                         
2      I  (IMAX,MEND1,JBLK1,JBLK2,KMAX,KGX,KQX,KQWX,GW,GD,                        
3      O   WD)                                                                    
4 C                                                                               
5       DIMENSION   GD(IMAX,JBLK2,*),WD(KQWX,MEND1,JBLK2),GW(JBLK2)               
6 C                                                                               
7       DO 100 K=1,KMAX                                                           
8       DO 100 J=1,JBLK1                                                          
9 C      JS=J                                                                     
10 C      JA=J+JBLK1                                                               
11 *vdir nodep                                                                  
12       DO 100 M=1,MEND1                                                          
13        WD(KQX+2*K-1,M,J      )=                                                 
14      &             GW(J)*(GD(2*M-1,J,KGX+K)+GD(2*M-1,JBLK2+1-J,KGX+K))          
15        WD(KQX+2*K  ,M,J      )=                                                 
16      &             GW(J)*(GD(2*M  ,J,KGX+K)+GD(2*M  ,JBLK2+1-J,KGX+K))          
17        WD(KQX+2*K-1,M,J+JBLK1)=                                                 
18      &             GW(J)*(GD(2*M-1,J,KGX+K)-GD(2*M-1,JBLK2+1-J,KGX+K))          
19        WD(KQX+2*K  ,M,J+JBLK1)=                                                 
20      &             GW(J)*(GD(2*M  ,J,KGX+K)-GD(2*M  ,JBLK2+1-J,KGX+K))          
21   100 CONTINUE                                                                  
22 C                                                                               
23       RETURN                                                                    
24       END SUBROUTINE WEIHT2
25