w_rwar.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	w_rwar (nprw, lprw, rwl, rwsav, lwsav_l, cep, proc, len_am)

Function/Subroutine Documentation

w_rwar()

subroutine w_rwar	(	integer, dimension(*)	nprw,
		integer, dimension(*)	lprw,
			rwl,
			rwsav,
		integer	lwsav_l,
		integer, dimension(*)	cep,
		integer	proc,
		integer	len_am )

Definition at line 31 of file w_rwar.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------  
 
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
       INTEGER  PROC, LEN_AM, LWSAV_L, LPRW(*), NPRW(*),
     .          CEP(*)
       my_real
     .          rwl(nrwlp,*), rwsav(*)
C-----------------------------------------------
C   F u n c t i o n
C-----------------------------------------------
      INTEGER  NLOCAL
      EXTERNAL nlocal    
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, K, KK, N, NN, IE, NE, ITY, IFQ, N4,
     .        ILP, NSL, NSL_L, KSAV, KSAV_L
      my_real    , DIMENSION(:),ALLOCATABLE :: rwsav_l
      my_real    , DIMENSION(:,:),ALLOCATABLE :: rwl_l
C
      IF(nrwall>0) THEN
        ALLOCATE(rwl_l(nrwlp,nrwall))
        IF(lwsav_l>0) ALLOCATE(rwsav_l(3*lwsav_l))
        k = 0
        ksav = 0
        ksav_l = 0
        DO n = 1, nrwall
          DO j = 1, nrwlp
            rwl_l(j,n) = rwl(j,n)
          ENDDO
C
          nsl = nprw(n)
C
          ifq = nint(rwl(15,n))
          IF(ifq>0) THEN
            nsl_l = 0
            DO kk = 1, nsl
              nn = lprw(k+kk)
              IF(nlocal(nn,proc+1)==1)THEN            
                rwsav_l(ksav_l+3*nsl_l+1) = rwsav(ksav+3*(kk-1)+1)
                rwsav_l(ksav_l+3*nsl_l+2) = rwsav(ksav+3*(kk-1)+2)
                rwsav_l(ksav_l+3*nsl_l+3) = rwsav(ksav+3*(kk-1)+3)
                nsl_l = nsl_l + 1
              ENDIF
            ENDDO
            ksav = ksav + 3*nsl
            ksav_l = ksav_l + 3*nsl_l
          ENDIF
C
          k = k + nsl
C
          n4 = n + 3*nrwall
          IF(nprw(n4)==-1) THEN
C RW ALE TH
           ne = nint(rwl(8,n))
           IF(ne>0)THEN
            ilp = 0
            DO j = 1, ne
              ie = lprw(k+j)/10
              IF(cep(ie)==proc) THEN
                ilp = ilp + 1
              ENDIF
            ENDDO
            rwl_l(8,n) = ilp
            k = k + ne
           ENDIF
          ENDIF
        ENDDO
C
        CALL write_db(rwl_l,nrwlp*nrwall)
        len_am = len_am + nrwlp*nrwall
        DEALLOCATE(rwl_l)
        IF(lwsav_l>0) THEN
          CALL write_db(rwsav_l,lwsav_l*3)
          len_am = len_am + lwsav_l*3
          DEALLOCATE(rwsav_l)
        ENDIF
      ENDIF
C
      RETURN