w_drape.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	w_drape (drape, indx, cep, p, numel, numel_l, neldrp_l, len_ia, len_am)

Function/Subroutine Documentation

w_drape()

subroutine w_drape	(	type(drape_), dimension(numelc_drape + numeltg_drape)	drape,
		integer, dimension(numel)	indx,
		integer, dimension(*)	cep,
		integer	p,
		integer	numel,
		integer	numel_l,
		integer	neldrp_l,
		integer	len_ia,
		integer	len_am )

Definition at line 31 of file w_drape.F.

         USE drape_mod
C---------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "mvsiz_p.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER CEP(*), P, NUMEL, NUMEL_L, LEN_AM,LEN_IA
      TYPE(DRAPE_), DIMENSION(NUMELC_DRAPE + NUMELTG_DRAPE):: DRAPE
      INTEGER, DIMENSION(NUMEL) :: INDX
C-----------------------------------------------
C   F u n c t i o n
C-----------------------------------------------
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, EL, J,NPT,NDIM,IDX,NUMELDRP_L,NDIM_SLICE,
     .        NDIM_INDX_PLY,K,II,IS,NEL,NSLICE,NELDRP_L,NPT_DRP
      my_real, DIMENSION(:,:), ALLOCATABLE :: rtmp
      my_real, DIMENSION(:)  , ALLOCATABLE :: thk
      INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITMP
      INTEGER, DIMENSION(:)  , ALLOCATABLE :: NPTDRP_ELT,ISLICE,INDX_PLY,
     .                                        NPT_ELT,INDEX
C-----------------------------------------------
!     allocate 2d array
! --------------------------------------
C
      ALLOCATE(npt_elt(numel_l),nptdrp_elt(numel_l), index(numel_l),thk(numel_l)) 
C    
      index = 0
      nptdrp_elt =0
      npt_elt =0
      thk  = zero
      !
      ndim = 0
      nel = 0
      ndim_slice = 0
      ndim_indx_ply = 0
      ndim = 0
      neldrp_l = 0
      DO i = 1, numel
        IF(cep(i)== p) THEN
          ii = indx(i)
          nel = nel + 1 
          IF(ii > 0) THEN
            neldrp_l = neldrp_l + 1  
            index(nel) = neldrp_l
            npt_drp =  drape(ii)%NPLY_DRAPE
            npt = drape(ii)%NPLY
            nptdrp_elt(neldrp_l)   = npt_drp
            npt_elt(neldrp_l ) = npt
            thk(neldrp_l) = drape(ii)%THICK
            DO j = 1,npt_drp
              nslice = drape(ii)%DRAPE_PLY(j)%NSLICE
              ndim = ndim + nslice
            ENDDO
            ndim_slice = ndim_slice + npt_drp
            ndim_indx_ply = ndim_indx_ply + npt
          ENDIF
         ENDIF 
      ENDDO
      IF(neldrp_l > 0) THEN
C      
          ALLOCATE(itmp(ndim,2),rtmp(ndim,2),islice(ndim_slice),indx_ply(ndim_indx_ply))
C
          ndim_slice = 0
          ndim_indx_ply = 0
          ndim = 0 
          neldrp_l = 0
          nel = 0
          DO i = 1, numel
            IF(cep(i)== p) THEN
              ii = indx(i)
              nel = nel + 1 
              IF(ii > 0) THEN
                neldrp_l = neldrp_l + 1  
                npt_drp =  drape(ii)%NPLY_DRAPE
                npt = drape(ii)%NPLY
                DO j = 1,npt_drp
                  nslice = drape(ii)%DRAPE_PLY(j)%NSLICE
                  islice(ndim_slice + j) =  nslice
                  DO is = 1,nslice
                      itmp(ndim + is,1) = drape(ii)%DRAPE_PLY(j)%IDRAPE(is,1) 
                      itmp(ndim + is,2) = drape(ii)%DRAPE_PLY(j)%IDRAPE(is,2)
                      rtmp(ndim + is,1) = drape(ii)%DRAPE_PLY(j)%RDRAPE(is,1)
                      rtmp(ndim + is,2) = drape(ii)%DRAPE_PLY(j)%RDRAPE(is,2)
                  ENDDO
                  ndim = ndim + nslice
                ENDDO
                ndim_slice = ndim_slice + npt_drp
                DO j = 1,npt
                  indx_ply(ndim_indx_ply + j) = drape(ii)%INDX_PLY(j)
                ENDDO
                ndim_indx_ply = ndim_indx_ply + npt
              ENDIF
            ENDIF  
          ENDDO      
C     
          CALL write_i_c(ndim, 1)
          CALL write_i_c(ndim_slice,1)
          Call write_i_c(ndim_indx_ply,1) 
          CALL write_i_c(index,numel_l)
          CALL write_i_c(nptdrp_elt,neldrp_l)
          CALL write_i_c(npt_elt,neldrp_l)
          CALL write_i_c(islice,ndim_slice)
          CALL write_i_c(indx_ply,ndim_indx_ply)
          CALL write_i_c(itmp,2*ndim)     
          CALL write_db(rtmp,2*ndim)
          CALL write_db(thk,neldrp_l)
          len_am = len_am + 2*ndim   +   neldrp_l      
          len_ia = len_ia + 2*ndim +  numel_l   + 2*neldrp_l    
     .                    + ndim_slice + ndim_indx_ply  + 3   
           DEALLOCATE(itmp,rtmp,islice,indx_ply,npt_elt,nptdrp_elt, index,thk) 
       ENDIF
! --------------------------------------
      RETURN