i25main_free.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "macro.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "timeri_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i25main_free (timers, itask, ipari, intbuf_tab, intlist25, isendto, irecvfrom)

Function/Subroutine Documentation

i25main_free()

subroutine i25main_free	(	type(timer_)	timers,
		integer	itask,
		integer, dimension(npari,ninter)	ipari,
		type(intbuf_struct_), dimension(ninter)	intbuf_tab,
		integer, dimension(*)	intlist25,
		integer, dimension(nspmd+1,*)	isendto,
		integer, dimension(nspmd+1,*)	irecvfrom )

Definition at line 39 of file i25main_free.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE timer_mod
      USE intbufdef_mod   
      USE tri7box
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
#include      "macro.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "timeri_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(TIMER_) :: TIMERS
      INTEGER IPARI(NPARI,NINTER),ITASK,INTLIST25(*)
      INTEGER ISENDTO(NSPMD+1,*),IRECVFROM(NSPMD+1,*)
C     REAL
      TYPE(INTBUF_STRUCT_),DIMENSION(NINTER) :: INTBUF_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N, NIN, NRTM, IEDGE, NEDGE
C     REAL
      my_real
     .   startt, stopt
C-----------------------------------------------
      DO n = 1,ninter25
        nin = intlist25(n)
 
        nrtm   = ipari(4,nin)
        iedge  = ipari(58,nin)
        nedge  = ipari(68,nin)
C
        IF(iedge/=0)THEN
          CALL  i25edge_switch(
     .      itask+1,intbuf_tab(nin)%STFM,intbuf_tab(nin)%STFE,intbuf_tab(nin)%MVOISIN,iedge,
     .      nedge,intbuf_tab(nin)%LEDGE)
C
          CALL my_barrier
C
        END IF
C
!$OMP SINGLE
        CALL i25free_bound( 
     1    nrtm,intbuf_tab(nin)%MVOISIN,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%STFM,
     .                                                    intbuf_tab(nin)%NRTM_FREE,
     2    intbuf_tab(nin)%FREE_IRECT_ID)
!$OMP END SINGLE
      END DO
C-----------------------------------------------------------
      IF (imon>0 .AND. itask==0) THEN
        CALL startime(timers,macro_timer_t25stfe)
      ENDIF
C       
!$OMP SINGLE
      DO n = 1,ninter25
       nin = intlist25(n)
       IF(ipari(macro_iedge,nin) > 0) THEN
C
C        Also needed in SMP for resetting STFE !
         CALL spmd_get_stif25_edg(
     .     intbuf_tab(nin)%STFE,    ipari(macro_nedge,nin), intbuf_tab(nin)%LEDGE,
     .     nin ,  isendto, irecvfrom, intbuf_tab(nin)%MPI_COMM, intbuf_tab(nin)%RANK, 
     .     intbuf_tab(nin)%NSPMD)
       ENDIF
      ENDDO
!$OMP END SINGLE
C
      IF (imon>0 .AND. itask==0) THEN
        CALL stoptime(timers,macro_timer_t25stfe)
      ENDIF
C-----------------------------------------------------------
      RETURN