hm_read_thvarc.F File Reference

#include "implicit_f.inc"
#include "r2r_c.inc"

Go to the source code of this file.

Functions/Subroutines
integer function	hm_thvarc (vare, nv, ivar, varg, nvg, ivarg, nv0, id, titr, lsubmodel)

Function/Subroutine Documentation

hm_thvarc()

integer function hm_thvarc	(	character*10, dimension(nv), target	vare,
		integer	nv,
		integer, dimension(*)	ivar,
		character*10, dimension(nvg), target	varg,
		integer	nvg,
		integer, dimension(18,*)	ivarg,
		integer	nv0,
		integer	id,
		character(len=nchartitle)	titr,
		type(submodel_data), dimension(nsubmod)	lsubmodel )

Definition at line 45 of file hm_read_thvarc.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
      USE th_mod , ONLY : th_has_noda_pext
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      "r2r_c.inc"
C-----------------------------------------------
      INTEGER NV,NVG,IVAR(*),IVARG(18,*),NV0
      CHARACTER*10,TARGET :: VARE(NV),VARG(NVG)
      INTEGER ID
      CHARACTER(LEN=NCHARTITLE) :: TITR
      TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      LOGICAL IS_AVAILABLE
      INTEGER,DIMENSION(:),ALLOCATABLE :: TAG
      CHARACTER VAR*10
      INTEGER JREC,NVAR,TRU,N,L,M,I,J,K,OK
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      ! Tag must start from 0
      ALLOCATE(tag(0:nv))
C
      ! Number of variables indicated by the user
      CALL hm_get_intv('Number_Of_Variables',nvar,is_available,lsubmodel) 
c
      ! Initialization of the tag table
      DO i=1,nv
        tag(i)=0
      ENDDO
c
      ! Loop over variables
      DO k=1,nvar
        CALL hm_get_string_index('VAR',var,k,10,is_available)
        var(len_trim(var)+1:10)=' '
        IF (var(1:4) == 'QVIS')var='BULK'                       
        IF (var(1:6) == 'ALL_42') THEN                
          DO i=1,nv0                                 
            tag(i)=1                                 
          ENDDO 
        ELSEIF (var(1:3) == 'ALL') THEN                       
          CALL ancmsg(msgid=551,                     
     .                msgtype=msgerror,              
     .                anmode=aninfo,                 
     .                i1=id,                         
     .                c1=titr,                       
     .                c2=var)                                                                 
        ELSEIF (var(1:5) == '     ') THEN        
          cycle
        ELSE   
          ok = 0                                      
          DO i=1,nvg                                                                  
            IF(var == varg(i))THEN                   
                DO j=1,18                            
                  tag(ivarg(j,i))=1                  
                ENDDO                                
                ok=1 
                EXIT                                
            ENDIF                                    
          ENDDO                                      
c                                                     
          IF(ok==0)THEN                                       
            DO i=1,nv                                                             
              IF(var == vare(i))THEN
                IF(var(1:4) == 'PEXT ')THEN
                  th_has_noda_pext = 1
                ENDIF
                tag(i)=1                             
                ok=1                                 
C---------Multidomaines : pour les subsets, on stocke des infos en plus dans le th pour merge---------                      
                    IF ((nsubdom>0).AND.(sub_flag==1002)) THEN                                        
                    IF (i>=9) THEN                                                                     
                      tag(3) = 1                                                                         
                      tag(4) = 1                                                                         
                      tag(5) = 1                                                                         
                      tag(6) = 1                                                                         
                      tag(9) = 1                                                                         
                      tag(10) = 1                                                                        
                      tag(11) = 1                                                                        
                    ENDIF                                                                                
                    IF (i==23) THEN                                                                    
                      DO j=12,20                                                                         
                        tag(j)=1                                                                         
                      ENDDO                                                                              
                    ENDIF                                                                                
                  ENDIF                                                                                  
C---------  ----------------------------------------------------------------------------------------------  
                EXIT                  
              ENDIF                             
            ENDDO      
          ENDIF                         
                                              
          IF(ok==0)THEN                     
             CALL ancmsg(msgid=260,           
     .                   msgtype=msgerror,    
     .                   anmode=aninfo,       
     .                   i1=id,               
     .                   c1=titr,             
     .                   c2=var)              
          ENDIF                               
       ENDIF
      ENDDO 
      
      nvar=0
      DO i=1,nv
        IF(tag(i) /= 0)THEN
          nvar=nvar+1
          ivar(nvar)=i
        ENDIF
      ENDDO
         
      
      hm_thvarc=nvar
       
      DEALLOCATE(tag)
      RETURN