unit_code.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	unit_code (length, field, key, fac, ierr1, id)

Function/Subroutine Documentation

unit_code()

subroutine unit_code	(	integer	length,
		character, dimension(*)	field,
		character, dimension(*)	key,
			fac,
		integer	ierr1,
		integer	id )

Definition at line 33 of file unit_code.F.

      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,N,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