unit_code.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/.
!||====================================================================
!||    unit_code      ../starter/source/general_controls/computation/unit_code.F
!||--- called by ------------------------------------------------------
!||    hm_read_unit   ../starter/source/general_controls/computation/hm_read_unit.F
!||--- calls      -----------------------------------------------------
!||    ancmsg         ../starter/source/output/message/message.F
!||--- uses       -----------------------------------------------------
!||    format_mod     ../starter/share/modules1/format_mod.F90
!||    message_mod    ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE unit_code(LENGTH,FIELD,KEY,FAC,IERR1,ID)
      USE message_mod
      USE format_mod , ONLY : fmt_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 LENGTH,IERR1,ID
      CHARACTER FIELD*(*),KEY*(*)               !precondition:LEN(KEY)>=4 ('-check bounds' error otherwise)
      my_real fac
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, J1, J2, J3, IREEL
      CHARACTER CFAC*20, CUNIT
C=======================================================================
      ireel = 0
      READ(field,err=100,fmt=fmt_f) fac
      ireel=1
* La valeur entree est un reel
100   CONTINUE
* La valeur entree est un code (ou une erreur)
      IF (ireel == 0) THEN  
         cfac='  '                                         
         ierr1= 1
         i   = 1                                   
         j   = 0                                   
         j1  = 1                                           
         j2  = 1                                           
         j3  = 1                                           
C        Skip leading spaces
         DO WHILE (i <= length)
           IF (field(i:i) /= ' ') EXIT
           i=i+1
         ENDDO
C        Read, skip trailing spaces
         DO WHILE (i <= length)
           IF (field(i:i) == ' ') EXIT
           j=j+1
           i=i+1                                           
         ENDDO
         j3 = i-1
         IF (j == 1) THEN    
           cunit=field(j3:j3)
         ELSEIF (j == 2) THEN  
           j1 = j3-1  
           cunit=field(j3:j3)
           cfac(1:2)=field(j1:j1)                           
         ELSEIF (j == 3) THEN  
           j1 = j3-2  
           j2 = j3-1  
           cunit=field(j3:j3)
           cfac(1:2)=field(j1:j2)
         ELSE          
           j1 = -huge(j1)
           j2 = -huge(j2)
           cunit=''
           cfac(1:2)=''
           ierr1=0
         ENDIF 
C---
        SELECT CASE (cfac(1:2))
        CASE ('y ')
            fac=em20*em04
        CASE ('z ')                    
            fac=em20*em01
        CASE ('a ')               
            fac=em18
        CASE ('p ')        
            fac=em12
        CASE ('f ')   
            fac=em15
        CASE ('n ')        
            fac=em09
        CASE ('mu', 'u ')
            ! greek letter mu was converted into ascii by subroutine ascii_encoding_mu_letter
            fac=em06
        CASE ('m ')
            fac=em03
        CASE ('c ')
            fac=em02
        CASE ('d ')
            fac=em01
        CASE ('  ')
            fac=one
        CASE ('da')
            fac=ten
        CASE ('h ')
            fac=hundred
        CASE ('k ')
            fac=ep03
        CASE ('K ')
            fac=ep03
        CASE ('M ')
            fac=ep06
        CASE ('G ')
            fac=ep09
        CASE ('T ')
            fac=ep12
        CASE ('P ')
            fac=ep15
        CASE ('E ')
            fac=ep18
        CASE ('Z ')
            fac=ep20*ten
        CASE ('Y ')
            fac=ep20*ep04
        CASE DEFAULT      
            fac=-huge(fac) 
            ierr1=0
        END SELECT                                           
*       L'unite SI de masse est le kg et pas le g
        IF (key(1:4) == 'MASS') fac=fac*em03
C---
        IF ((              key(1:4) == 'MASS'  .AND.cunit /= 'g').OR.   
     .      (key(1:min(len(key),6)) == 'LENGTH'.AND.cunit /= 'm').OR.   
     .      (              key(1:4) == 'TIME'  .AND.cunit /= 's').OR.   
     .      (ierr1 == 0) 
     .      ) THEN                               
           CALL ancmsg(msgid=573,msgtype=msgerror,anmode=aninfo_blind_1,i1=id,c2=key,c1=field(j1:j3))
        ENDIF                                              
C-----
      ENDIF                                     
C-----
      RETURN
      END