surf_mass.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	surf_mass_monv (fsavsurf, igrsurf, monvol, volmon, fr_mv)
subroutine	surf_mass_fvm (ntgi, itag, elfmass, mass, elfvel, vel, elsini)
subroutine	surf_mass_com (icbag, rcbag, nca, idsurf, mass, vel)

Function/Subroutine Documentation

surf_mass_com()

subroutine surf_mass_com	(	integer, dimension(nicbag,*)	icbag,
			rcbag,
		integer	nca,
		integer	idsurf,
			mass,
			vel )

Definition at line 156 of file surf_mass.F.

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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICBAG(NICBAG,*), NCA, IDSURF
C     REAL
      my_real
     .   rcbag(nrcbag,*), mass, vel
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, IDCOM
C-----------------------------------------------
      DO i=1,nca
        idcom = icbag(2,i)
        IF(idcom /= idsurf) cycle
        mass = mass+rcbag(8,i)
        vel  = vel +rcbag(9,i)
      ENDDO
C
      RETURN

surf_mass_fvm()

subroutine surf_mass_fvm	(	integer	ntgi,
		integer, dimension(*)	itag,
			elfmass,
			mass,
			elfvel,
			vel,
			elsini )

Definition at line 120 of file surf_mass.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NTGI, ITAG(*)
      my_real
     .   elfmass(*), mass, elfvel(*), vel, elsini(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
      my_real surf
C-----------------------------------------------
      mass = zero
      surf = zero
      vel  = zero
      DO i=1,ntgi
        IF(itag(i+1) == 0) cycle
        mass=mass+elfmass(i)
        surf=surf+elsini(i)
        vel =vel +elfvel(i)*elsini(i)
      ENDDO
      mass=abs(mass)
      vel =abs(vel)/surf
C
      RETURN

surf_mass_monv()

subroutine surf_mass_monv	(		fsavsurf,
		type (surf_), dimension(nsurf)	igrsurf,
		integer, dimension(*)	monvol,
			volmon,
		integer, dimension(nspmd+2,nvolu)	fr_mv )

Definition at line 34 of file surf_mass.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE groupdef_mod
      USE th_surf_mod , only : th_surf_num_channel
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      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER MONVOL(*), FR_MV(NSPMD+2,NVOLU)
      my_real fsavsurf(th_surf_num_channel,nsurf), volmon(*)
      TYPE (SURF_), DIMENSION(NSURF) :: IGRSURF
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, N, NN, IAD, KAD, ITYP, NCA, IDSURF, PMAIN
      INTEGER NTG, NTGI, NNT, KIBALE, KRBALE
      INTEGER K1, K2, KK2, KI4, KR5, KR6, KR7, NNS, NNI, NTGT
      INTEGER :: KR1, KR2, KR3, KR4
C-----------------------------------------------------------------------
         k1 = 1
         k2 = 1+nimv*nvolu
         kk2 = 1+nrvolu*nvolu
         kibale=1+nimv*nvolu  +licbag+libagjet+libaghol
         krbale=1+nrvolu*nvolu+lrcbag+lrbagjet+lrbaghol
         DO n=1,nvolu
           nca  = monvol(k1-1+3)
           pmain = fr_mv(nspmd+2,n)
           IF(ispmd+1 == pmain) THEN
             ityp = monvol(k1-1+2)
             IF(ityp == 6.OR.ityp == 8) THEN
               ntgi = monvol(k1-1+69)
               IF(ntgi == 0) cycle
               ntg = monvol(k1-1+33)
               ntgt = ntg + ntgi
               kad = kibale+monvol(k1-1+18)
               nns = monvol(k1-1+32)
               nni = monvol(k1-1+68) 
               nnt = nns + nni
               kr1=krbale+monvol(k1-1+34)
               kr2=kr1+nnt
               kr3=kr2+nnt
               kr4=kr3+nnt
               kr5=kr4+3*nnt
               kr6=kr5+ntgt
               kr7 = kr6+ntg+ntgi
               DO i=1,nsurf
                  IF(igrsurf(i)%TH_SURF == 1) THEN
                     IF(monvol(kad) /= 0) CALL surf_mass_fvm(ntgi, monvol(kad),
     .                  volmon(kr6), fsavsurf(2,i), volmon(kr7), fsavsurf(3,i),
     .                  volmon(kr5))
                  ENDIF
                  kad = kad+ntgi+1
               ENDDO
             ELSEIF(ityp == 9 .AND. nca > 0) THEN
               DO i=1,nsurf
                  IF(igrsurf(i)%TH_SURF /= 1) cycle
                  idsurf=i
                  CALL surf_mass_com(monvol(k2), volmon(kk2), nca, idsurf,
     .                               fsavsurf(2,i),fsavsurf(3,i))
               ENDDO
             ENDIF       
           ENDIF
           k1 = k1+nimv
           k2 = k2+nicbag*nca
           kk2 = kk2+nrcbag*nca
         ENDDO
C
      RETURN