mod_handle_friction_zones.f

Go to the documentation of this file.

!     ********************************
      MODULE mod_handle_friction_zones
!     ********************************
!
!***********************************************************************
! PARTEL
!***********************************************************************
!
!BRIEF    Treatment of sections
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

        IMPLICIT NONE
        CONTAINS
!     ********************************
      SUBROUTINE handle_friction_zones
!     ********************************
!
     &        (namezfi, nparts, npoin, npoin_p, max_npoin_p, knolg)
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| NAMEZFI        |<--| Name of friction zones file
!| NPARTS         |<--| Number of partitions
!| NPOIN          |<--| Number of points
!| NPOIN_P        |<--| Number of points per partition
!| MAX_NPOIN_P    |<--| Maxw Number of points on a partition
!| KNOLG          |<--| Local to global numbering
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      USE declarations_partel
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      CHARACTER(LEN=PATH_LEN), INTENT(IN) :: NAMEZFI
      INTEGER, INTENT(IN) :: NPARTS
      INTEGER, INTENT(IN) :: NPOIN
      INTEGER, INTENT(IN) :: MAX_NPOIN_P
      INTEGER, INTENT(IN) :: NPOIN_P(nparts)
      INTEGER, INTENT(IN) :: KNOLG(max_npoin_p, nparts)
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      INTEGER, ALLOCATABLE :: FRICTION(:)
      INTEGER :: NZFI,I_GLOB,VAL_ZFI
      CHARACTER(LEN=11) :: EXTENS
      EXTERNAL extens
      INTEGER I, J, N, IERR
      CHARACTER(LEN=PATH_LEN)  :: NAMEOUT
!
!     READING THE FRICTION INFORMATIONS
      CALL get_free_id(nzfi)
      OPEN(nzfi,file=trim(namezfi),form='FORMATTED',status='OLD')
      ALLOCATE (friction(npoin), stat=ierr)
      CALL check_allocate(ierr, 'FRICTION')
      friction(:) = 0
      DO j=1,npoin
        READ(nzfi,*,end=304,err=303) i, val_zfi
        friction(i) = val_zfi
      ENDDO
      CLOSE(nzfi)
!
      DO n=1,nparts
        nameout=trim(namezfi)//extens(nparts-1,n-1)

        WRITE(lu,*) 'WRITING: ', trim(nameout)

        OPEN (nzfi,file=trim(nameout),form='FORMATTED',status='NEW')
        DO i=1,npoin_p(n)
          i_glob = knolg(i,n)
          WRITE(nzfi,*) i, friction(i_glob)
        END DO
        CLOSE(nzfi)
      END DO
      DEALLOCATE(friction)
      RETURN
!
 303  WRITE(lu,*) 'ERROR WITH ZONE FILE FORMAT'
      GO TO 999
 304  WRITE(lu,*) 'ABNORMAL END OF FILE'
      GO TO 999
 999  CALL plante(1)
      stop
      END SUBROUTINE
      END MODULE