update_struct_int21.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "task_c.inc"
#include "parit_c.inc"
#include "spmd_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	update_struct_int21 (cand_e, ii_stok, iform, nin, nmn, intth, mndd, msr_l, irectt)

Function/Subroutine Documentation

update_struct_int21()

subroutine update_struct_int21	(	integer, dimension(*)	cand_e,
		integer	ii_stok,
		integer	iform,
		integer	nin,
		integer	nmn,
		integer	intth,
		integer, dimension(*)	mndd,
		integer, dimension(*)	msr_l,
		integer, dimension(4,*)	irectt )

Definition at line 34 of file update_struct_int21.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE intstamp_glob_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"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "task_c.inc"
#include      "parit_c.inc"
#include      "spmd_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  NIN,NMN,IFORM
      INTEGER  MSR_L(*),MNDD(*)
      INTEGER CAND_E(*)
      INTEGER II_STOK,INTTH,IRECTT(4,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, IP0, IP1, II,IFLAGLOADP,
     .        N,L,PP,J_STOK,IAD(NSPMD),
     .        TAG(NMN),NM(4),NODFI,PTR, IERROR1,IERROR2, IERROR3,
     .        IERROR4,LSKYFI
 
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
C UPDATE STRUCTURE NMNSI and NMNFI FOR SPMD COMMUNICATION
C
       iflagloadp = 0
 
        IF(nspmd > 1.AND.(intth == 2.OR.iflagloadp > 0)) THEN
            CALL my_barrier
!$OMP MASTER
            tag(1:nmn)=0
            nodfi = 0
            nmnfi(nin)%P(1:nspmd) = 0
            DO i=1,ii_stok 
                l = cand_e(i)
                IF(l/=0) THEN             
                    nm(1:4) = irectt(1:4,l)
                    DO j=1,4
                        ii = nm(j)
                        pp = mndd(ii)
                        IF(pp/=0.AND.tag(ii) == 0) THEN                     
                            nodfi = nodfi + 1
                            nmnfi(nin)%P(pp) = nmnfi(nin)%P(pp) +1
                            tag(ii)=1
                        ENDIF 
                    ENDDO
                ENDIF
            ENDDO 
 
            IF(ASSOCIATED( nmvfi(nin)%P )) DEALLOCATE(nmvfi(nin)%P)
            ALLOCATE(nmvfi(nin)%P(nodfi),stat=ierror1)
C
            iad(1)=1
            DO i=1,nspmd-1
                iad(i+1) = iad(i)+nmnfi(nin)%P(i)
            ENDDO
 
C
            tag(1:nmn)=0
            DO i=1,ii_stok 
                l = cand_e(i)
                IF(l/=0) THEN 
                    nm(1:4) = irectt(1:4,l)  
                    DO j=1,4
                        ii=nm(j)
                        pp = mndd(ii)
                        IF(pp/=0.AND.tag(ii)==0)  THEN
                            ptr = iad(pp)
                            nmvfi(nin)%P(ptr) = ii
                            tag(ii)=1
                            iad(pp)=iad(pp)+1
                            msr_l(ii) = -ptr
                        ENDIF
                    ENDDO
                ENDIF
            ENDDO 
       
 
C
            IF(iform /= 0) THEN 
                IF(iparit==0) THEN
                    IF(nodfi>0)ALLOCATE(fthefi(nin)%P(nodfi*nthread),stat=ierror2)
                    DO i = 1, nodfi*nthread
                        fthefi(nin)%P(i) = zero
                    ENDDO
                ELSE
                    IF(ASSOCIATED(ftheskyfi(nin)%P)) DEALLOCATE(ftheskyfi(nin)%P)
                    lskyfi = nodfi*multimax
                    nlskyfi(nin) = lskyfi
                    IF(lskyfi>0) THEN
                        ALLOCATE(iskyfi(nin)%P(lskyfi),stat=ierror3)
                        ALLOCATE(ftheskyfi(nin)%P(lskyfi),stat=ierror4)
                    ENDIF
                ENDIF
            ENDIF
 
            IF (iflagloadp > 0) THEN
                IF(nodfi>0) THEN 
                  IF(ASSOCIATED( tagncontfi(nin)%P )) DEALLOCATE(tagncontfi(nin)%P)
                   ALLOCATE(tagncontfi(nin)%P(nodfi),stat=ierror2)   
                     DO i = 1, nodfi
                        tagncontfi(nin)%P(i) = 0
                    ENDDO
                ENDIF            
            ENDIF
!$OMP END MASTER
            CALL my_barrier     !   there isn't any implicit barrier at the end 
                                !   of an omp main condition
        ENDIF    
 
        RETURN