hm_submodpart.F File Reference

#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_submodpart (isubmod, tagbuf, ipart, id, flag, mess, titr, titr1, indx, nindx, lsubmodel)

Function/Subroutine Documentation

hm_submodpart()

subroutine hm_submodpart	(	integer, dimension(*)	isubmod,
		integer, dimension(*)	tagbuf,
		integer, dimension(lipart1,*)	ipart,
		integer	id,
		integer	flag,
		character, dimension(*)	mess,
		character(len=nchartitle)	titr,
		character(len=nchartitle)	titr1,
		integer, dimension(*)	indx,
		integer	nindx,
		type(submodel_data), dimension(*)	lsubmodel )

Definition at line 37 of file hm_submodpart.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE submodel_mod
      USE hm_option_read_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharline, ncharfield
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      "scr17_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER   TAGBUF(*),ISUBMOD(*),IPART(LIPART1,*), INDX(*)
      INTEGER   ID,FLAG,NINDX
      CHARACTER MESS(*)
      CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
      TYPE(SUBMODEL_DATA) LSUBMODEL(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,ISU,JREC,PARTID,CUR_SUBMOD,ISELECT,IOK,
     .        ID_SUB,IDU,ID1,UID1,SUB_INDEX,KK,JJ
      INTEGER  TAGS(NSUBMOD)
      CHARACTER(LEN=NCHARKEY) :: KEY
      CHARACTER(LEN=NCHARFIELD) :: VERS_IN
      CHARACTER(LEN=NCHARLINE) :: TITR2,CART
      LOGICAL IS_AVAILABLE,IS_ENCRYPTED
      INTEGER,DIMENSION(:),ALLOCATABLE :: LIST_ELEM
      INTEGER :: NENTITY      
C-----------------------------------------------
      INTERFACE
       SUBROUTINE groups_get_elem_list(arg1,arg2,arg3)
        USE submodel_mod
        INTEGER,DIMENSION(:),ALLOCATABLE       :: arg1
        INTEGER,INTENT(INOUT)                  :: arg2
        TYPE(SUBMODEL_DATA)                    :: arg3(NSUBMOD)
       END SUBROUTINE  
      END INTERFACE     
C=======================================================================
C     Tag submodels
C-------------------------
      tags(1:nsubmod)   = 0
      
      CALL groups_get_elem_list(list_elem, nentity, lsubmodel)                                                               
      DO kk=1,nentity                                                                                                            
        jj=list_elem(kk)                                              
        IF(jj > 0)THEN                                                                                                          
          isu=0                                                                                                                  
          iselect = 0                                                                                                            
          iok = 0                                                                                                                
          DO k=1,nsubmod                                                                                                         
            cur_submod = k                                                                                                       
            iselect = 0                                                                                                          
            DO WHILE (cur_submod /= 0 .AND. iselect == 0)                                                                    
              IF (lsubmodel(cur_submod)%NOSUBMOD == jj) iselect = 1                                                              
              IF (lsubmodel(cur_submod)%NOSUBMOD == -jj) iselect = -1                                                            
              cur_submod = lsubmodel(cur_submod)%IFATHER                                                                         
            ENDDO                                                                                                                
            IF (iselect == 1) THEN                                                                                               
              isu=k                                                                                                              
              tags(k) = tags(k) + 1                                                                                              
              iok = 1                                                                                                            
            ELSEIF (iselect == -1) THEN                                                                                          
              isu=k                                                                                                              
              tags(k) = tags(k) - 1                                                                                              
              iok = 1                                                                                                            
            ENDIF                                                                                                                
          ENDDO                                                                                                                  
          IF (iok == 0) CALL ancmsg(msgid=194,                                                                                   
     .                   msgtype=msgwarning,                                                                                     
     .                   anmode=aninfo,                                                                                          
     .                   i1=id,                                                                                                  
     .                   c1=titr1,                                                                                               
     .                   c2=titr,                                                                                                
     .                   c3='SUBMODEL',                                                                                          
     .                   i2=jj)                                                                                                  
        ENDIF                                                                                                                    
      ENDDO      
      IF(ALLOCATED(list_elem))DEALLOCATE (list_elem) 
 
C-------------------------
C     Tag Parts
C-------------------------   
      DO k=1,nsubmod 
        IF (tags(k) > 1) tags(k) = 1
        IF (tags(k) < -1) tags(k) = -1
      ENDDO 
 
C--------------------------------------------------
C BROWSING MODEL PARTS 1->NPART
C--------------------------------------------------
      DO i=1,npart
        sub_index = ipart(9,i)
        cur_submod = sub_index
        IF(tagbuf(i)==0 .AND. cur_submod > 0)THEN
          IF(tags(cur_submod) /=0 )THEN
            tagbuf(i)=tags(cur_submod)
            nindx=nindx+1
            indx(nindx)=i
          END IF
        END IF                
      ENDDO
C-------------------------
      RETURN