lec_inimap1d_file.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    lec_inimap1d_file      ../starter/source/initial_conditions/inimap/lec_inimap1d_file.F
!||--- called by ------------------------------------------------------
!||    hm_read_inimap1d       ../starter/source/initial_conditions/inimap/hm_read_inimap1d.f
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||--- uses       -----------------------------------------------------
!||    inimap1d_mod           ../starter/share/modules1/inimap1d_mod.F
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE lec_inimap1d_file(INIMAP1D, FILENAME, ID, TITLE)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------   
      USE inimap1d_mod
      USE message_mod
      USE groupdef_mod
      USE multi_fvm_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"
!NFUNCT
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(INIMAP1D_STRUCT), INTENT(INOUT) :: INIMAP1D
      CHARACTER(LEN=NCHARLINE),INTENT(INOUT) :: FILENAME
      INTEGER, INTENT(IN) :: ID
      CHARACTER(LEN=NCHARTITLE)::TITLE
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
      my_real x_scale,y_scale,x_shift,y_shift,tt
      INTEGER PREV, NEXT
      INTEGER :: LEN, LEN_TMP_NAME
      CHARACTER :: TMP_NAME*2048, FILNAM*2048
      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(1: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 = 1884, anmode = aninfo, msgtype = msgerror, i1 = id, c1=title)
            inimap1d%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(inimap1d%SUBMAT))ALLOCATE(inimap1d%SUBMAT(nbmat))                   
 
          !---ABSCISSA
          IF(.NOT.ALLOCATED(inimap1d%X))ALLOCATE(inimap1d%X(num_centroids))
          CALL read_db( inimap1d%X(1),num_centroids)
          CALL read_db( x_shift,1)                                                                                    
          !MOVE_FUNCTION
          DO k=1,num_centroids
            inimap1d%X(k) = inimap1d%X(k)+x_shift
          ENDDO               
          
          !---VOLUME FRACTION
          DO isubmat=1,nbmat                   
            IF(.NOT.ALLOCATED(inimap1d%SUBMAT(isubmat)%VFRAC))ALLOCATE(inimap1d%SUBMAT(isubmat)%VFRAC(num_centroids))
            CALL read_db( inimap1d%SUBMAT(isubmat)%VFRAC(1),num_centroids)
          ENDDO  
 
          !---DENSITIES
          DO isubmat=1,nbmat                  
            IF(.NOT.ALLOCATED(inimap1d%SUBMAT(isubmat)%RHO))ALLOCATE(inimap1d%SUBMAT(isubmat)%RHO(num_centroids))
            CALL read_db( inimap1d%SUBMAT(isubmat)%RHO(1),num_centroids)       
          ENDDO            
 
          !---PRESSURE
          DO isubmat=1,nbmat                  
            IF(.NOT.ALLOCATED(inimap1d%SUBMAT(isubmat)%PRES))ALLOCATE(inimap1d%SUBMAT(isubmat)%PRES(num_centroids))
            CALL read_db( inimap1d%SUBMAT(isubmat)%PRES(1),num_centroids)
          ENDDO  
 
          !---VELOCITY
          IF(.NOT.ALLOCATED(inimap1d%VEL))ALLOCATE(inimap1d%VEL(num_node_vel))
          IF(.NOT.ALLOCATED(inimap1d%X_VEL))ALLOCATE(inimap1d%X_VEL(num_node_vel))
          IF(num_node_vel == num_centroids)THEN
            CALL read_db( inimap1d%VEL(1),num_node_vel )
            DO k=1, num_node_vel  
              inimap1d%X_VEL(k) = inimap1d%X(k)       
            ENDDO
          ELSE
            CALL read_db( inimap1d%X_VEL(1),num_node_vel )
            CALL read_db( inimap1d%VEL(1),num_node_vel )
          ENDIF 
           
        CALL close_c()
 
        !check abscissa
        ! not needed : order already correct when it is built
        !PREV = INIMAP1D%X(1)
        !DO K=2,NUM_CENTROIDS-1
        !  NEXT = INIMAP1D%X(K)
        !  IF(PREV <= F)THEN
        !      CALL ANCMSG(MSGID = 1884, ANMODE = ANINFO, MSGTYPE = MSGERROR, I1 = INIMAP1D%ID, C1=INIMAP1D%TITLE)
        !    EXIT
        !  ENDIF
        !ENDDO
 
        inimap1d%NBMAT = nbmat 
        inimap1d%NUM_CENTROIDS = num_centroids     
        inimap1d%NUM_NODE_VEL = num_node_vel        
        inimap1d%FUNC_VEL = -1 
        IF(.NOT.ALLOCATED(inimap1d%FUNC_ALPHA))ALLOCATE(inimap1d%FUNC_ALPHA(nbmat))          
        IF(.NOT.ALLOCATED(inimap1d%FUNC_RHO))ALLOCATE(inimap1d%FUNC_RHO(nbmat))          
        IF(.NOT.ALLOCATED(inimap1d%FUNC_ENER))ALLOCATE(inimap1d%FUNC_ENER(nbmat))                          
        IF(.NOT.ALLOCATED(inimap1d%FUNC_PRES))ALLOCATE(inimap1d%FUNC_PRES(nbmat))                          
        DO isubmat=1,nbmat   
          inimap1d%FUNC_ALPHA(isubmat) = -1        
          inimap1d%FUNC_RHO(isubmat)   = -1        
          inimap1d%FUNC_ENER(isubmat)  = -1                        
          inimap1d%FUNC_PRES(isubmat)  = -1                        
        ENDDO
 
        IF(.NOT.ALLOCATED(inimap1d%FAC_RHO))ALLOCATE(inimap1d%FAC_RHO(nbmat))          
        IF(.NOT.ALLOCATED(inimap1d%FAC_PRES_ENER))ALLOCATE(inimap1d%FAC_PRES_ENER(nbmat))                  
        DO isubmat=1,nbmat
          inimap1d%FAC_RHO(isubmat) = one
          inimap1d%FAC_PRES_ENER(isubmat) = one
        ENDDO
        inimap1d%FAC_VEL = one
           
        
        RETURN
        
 999             CALL ancmsg(msgid = 1884, anmode = aninfo, msgtype = msgerror,
     .              i1 = inimap1d%ID, c1=inimap1d%TITLE)
  
 
      END SUBROUTINE lec_inimap1d_file