lec_inimap2d_file.F File Reference

#include "implicit_f.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	lec_inimap2d_file (inimap2d, filename, id, title)

Function/Subroutine Documentation

lec_inimap2d_file()

subroutine lec_inimap2d_file	(	type(inimap2d_struct), intent(inout)	inimap2d,
		character(len=ncharline), intent(inout)	filename,
		integer, intent(in)	id,
		character(len=nchartitle)	title )

Definition at line 35 of file lec_inimap2d_file.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------   
      USE inimap2d_mod
      USE func2d_mod
      USE message_mod
      USE groupdef_mod
      USE inoutfile_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharline
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      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(INIMAP2D_STRUCT), INTENT(INOUT) :: INIMAP2D
      CHARACTER(LEN=NCHARLINE), INTENT(INOUT) :: FILENAME
      INTEGER, INTENT(IN) :: ID
      CHARACTER(LEN=NCHARTITLE)::TITLE
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER USR2SYS
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      CHARACTER MESS*40,BUFFER*14
      CHARACTER(LEN=NCHARLINE) :: ROOTNAME
      DATA mess/'INFILE'/
      INTEGER NUM_CENTROIDS,N_CYCLE,K,ISUBMAT,NBMAT,NUM_NODE_VEL,INPUT_VERSION,NB_COMP
      my_real x_scale,y_scale,x_shift,y_shift,tt
      INTEGER :: LEN, LEN_TMP_NAME
      CHARACTER :: TMP_NAME*2048, FILNAM*204
      INTEGER :: IFILNAM(2048),II, NCYCLE, NCELL_TOT, INIVERS
      LOGICAL FILE_EXIST
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
        len = len_trim(filename)
        filnam=filename(:len)
        IF(len >= 3)THEN
          IF( filnam(len-2:len) == ".gz")THEN
            filnam(len-2:len)=' '
            len=len-3
          ENDIF
        ENDIF
        len_tmp_name = outfile_name_len + len
        !TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAM(1:LEN)
        tmp_name=filnam(1:len)
        DO ii=1,len_tmp_name
          ifilnam(ii)=ichar(tmp_name(ii:ii))
        END DO
        CALL cur_fil_c(iuinimap)
        CALL open_c(ifilnam,len_tmp_name,7)
        file_exist=.false.
        inquire( file=trim(filename), exist=file_exist )
        IF(.NOT.file_exist) THEN
          inquire( file=trim(filename)//".gz", exist=file_exist )
          IF(.NOT.file_exist) THEN
            CALL ancmsg(msgid = 1885, anmode = aninfo, msgtype = msgerror, i1 = id, c1=title)
            inimap2d%CORRECTLY_READ = .false.
            return
           ENDIF
        ENDIF 
                      
        CALL read_i_c(inivers,1)
        CALL read_db(tt,1)
        CALL read_i_c(ncycle,1)
        CALL read_i_c(num_centroids,1)
        CALL read_i_c(num_node_vel,1)
        CALL read_i_c(nbmat,1)   
        
          IF(.NOT.ALLOCATED(inimap2d%SUBMAT))ALLOCATE(inimap2d%SUBMAT(nbmat))                   
 
          !---ABSCISSA
          IF(.NOT.ALLOCATED(inimap2d%XVAL))ALLOCATE(inimap2d%XVAL(2,num_centroids))
          DO k=1,num_centroids
            CALL read_db(inimap2d%XVAL(1,k),1)
          ENDDO
          DO k=1,num_centroids
            CALL read_db(inimap2d%XVAL(2,k),1)
          ENDDO
          
          !---VOLUME FRACTION
          DO isubmat=1,nbmat                  
            IF(.NOT.ALLOCATED(inimap2d%SUBMAT(isubmat)%VFRAC))ALLOCATE(inimap2d%SUBMAT(isubmat)%VFRAC(1,num_centroids))
            DO k=1, num_centroids  
              CALL read_db(inimap2d%SUBMAT(isubmat)%VFRAC(1,k),1)        
            ENDDO 
          ENDDO                                                                                     
 
          !---DENSITIES
          DO isubmat=1,nbmat                  
            IF(.NOT.ALLOCATED(inimap2d%SUBMAT(isubmat)%RHO))ALLOCATE(inimap2d%SUBMAT(isubmat)%RHO(1,num_centroids))
            DO k=1, num_centroids  
              CALL read_db(inimap2d%SUBMAT(isubmat)%RHO(1,k),1)        
            ENDDO 
          ENDDO                                                                                                  
 
          !---PRESSURE
          DO isubmat=1,nbmat                  
            IF(.NOT.ALLOCATED(inimap2d%SUBMAT(isubmat)%PRES))ALLOCATE(inimap2d%SUBMAT(isubmat)%PRES(1,num_centroids))
            DO k=1, num_centroids  
              CALL read_db(inimap2d%SUBMAT(isubmat)%PRES(1,k),1)        
            ENDDO                                                                                  
          ENDDO  
 
          !---VELOCITY
          IF(.NOT.ALLOCATED(inimap2d%XVAL_V))ALLOCATE(inimap2d%XVAL_V(2,num_node_vel))
          IF(.NOT.ALLOCATED(inimap2d%VEL))ALLOCATE(inimap2d%VEL(2,num_node_vel))
          IF(num_node_vel == num_centroids)THEN
            DO k=1, num_node_vel 
              CALL read_db( inimap2d%VEL(1,k), 1)
              inimap2d%XVAL_V(1,k) = inimap2d%XVAL(1,k)    
            ENDDO    
            DO k=1, num_node_vel 
              CALL read_db( inimap2d%VEL(2,k), 1)
              inimap2d%XVAL_V(2,k) = inimap2d%XVAL(2,k)    
            ENDDO   
           ELSE
             DO k=1, num_node_vel ; CALL read_db( inimap2d%XVAL_V(1,k), 1) ; ENDDO 
             DO k=1, num_node_vel ; CALL read_db( inimap2d%XVAL_V(2,k), 1) ; ENDDO 
             DO k=1, num_node_vel ; CALL read_db( inimap2d%VEL(1,k), 1) ; ENDDO 
             DO k=1, num_node_vel ; CALL read_db( inimap2d%VEL(2,k), 1) ; ENDDO 
           ENDIF
           
        CALL close_c()
 
        inimap2d%NBMAT = nbmat 
        inimap2d%NUM_CENTROIDS = num_centroids     
        inimap2d%NUM_NODE_VEL = num_node_vel        
        inimap2d%FUNC_VEL = -1 
        IF(.NOT.ALLOCATED(inimap2d%FUNC_ALPHA))ALLOCATE(inimap2d%FUNC_ALPHA(nbmat))          
        IF(.NOT.ALLOCATED(inimap2d%FUNC_RHO))ALLOCATE(inimap2d%FUNC_RHO(nbmat))          
        IF(.NOT.ALLOCATED(inimap2d%FUNC_ENER))ALLOCATE(inimap2d%FUNC_ENER(nbmat))                          
        IF(.NOT.ALLOCATED(inimap2d%FUNC_PRES))ALLOCATE(inimap2d%FUNC_PRES(nbmat))  
        DO isubmat=1,nbmat   
          inimap2d%FUNC_ALPHA(isubmat) = -1        
          inimap2d%FUNC_RHO(isubmat) = -1        
          inimap2d%FUNC_ENER(isubmat) = -1                        
          inimap2d%FUNC_PRES(isubmat) = -1                        
        ENDDO
 
        IF(.NOT.ALLOCATED(inimap2d%FAC_RHO))ALLOCATE(inimap2d%FAC_RHO(nbmat))          
        IF(.NOT.ALLOCATED(inimap2d%FAC_PRES_ENER))ALLOCATE(inimap2d%FAC_PRES_ENER(nbmat))                  
        DO isubmat=1,nbmat
          inimap2d%FAC_RHO(isubmat) = one
          inimap2d%FAC_PRES_ENER(isubmat) = one
        ENDDO
        inimap2d%FAC_VEL = one
           
        
        RETURN
        
 999    CALL ancmsg(msgid = 1885, anmode = aninfo, msgtype = msgerror,
     .              i1 = inimap2d%ID, c1 = inimap2d%TITLE)