SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/OFFLIN/trans

Go to the documentation of this file.
00001 !----------------------------------------------------------
00002 SUBROUTINE TRANS_CHAINE(CHAINE,ENTIER,OPTION)
00003 !----------------------------------------------------------
00004 !
00005 ! transforme l'entier 23416 en la chaine de caracteres '23416' 
00006 ! option est utilise si superieur a 0. Dans ce cas si l'entier
00007 ! a un nombre de digits inferieur a option, la difference est
00008 ! remplie avec des '0' dans chaine.
00009 !
00010 !
00011 ! ex: entier=256 option=0  ===>   chaine='256'
00012 !     entier=256 option=2  ===>   chaine='256'
00013 !     entier=256 option=7  ===>   chaine='0000256'
00014 
00015 !
00016       USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00017       USE PARKIND1  ,ONLY : JPRB
00018 !
00019       IMPLICIT NONE
00020       DOUBLE PRECISION REEL1
00021       CHARACTER(LEN=*) CHAINE
00022       INTEGER OPTION
00023       CHARACTER              :: C
00024       INTEGER                :: RESTE , NBDIGIT , NUM , ENTIER, I, J
00025       DOUBLE PRECISION       :: DIVI
00026       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00027 
00028       IF (LHOOK) CALL DR_HOOK('TRANS_CHAINE',0,ZHOOK_HANDLE)
00029       REEL1  = ENTIER/1.
00030       CHAINE = ''
00031       RESTE  = ENTIER
00032       NBDIGIT= INT(LOG(REEL1)/LOG(10.)+0.001)+1
00033       DIVI   = 1
00034 
00035       DIG_LOOP: DO I = 1 , NBDIGIT - 1
00036       !-------------------------------
00037 
00038           DIVI = DIVI * 10
00039 
00040       END DO DIG_LOOP
00041       !---------------
00042 
00043       IF (OPTION.GT.0) THEN
00044          IF (OPTION.GT.NBDIGIT) THEN
00045 
00046             OPT_LOOP: DO I = 1 , OPTION - NBDIGIT
00047             !------------------------------------
00048 
00049                CHAINE(I:I)='0'
00050 
00051             END DO OPT_LOOP
00052             !---------------
00053           
00054          ENDIF
00055       ENDIF
00056 
00057       DIGI_LOOP: DO I = 1 , NBDIGIT
00058       !----------------------------
00059 
00060          NUM=INT(RESTE/DIVI)
00061          C=CHAR(NUM+48)
00062          IF (OPTION.GT.0) J=OPTION-NBDIGIT+I
00063          IF (OPTION.EQ.0) J=I
00064          CHAINE(J:J)=C
00065          RESTE=NINT(RESTE-NUM*DIVI)
00066          DIVI=DIVI/10
00067 
00068       END DO DIGI_LOOP
00069 IF (LHOOK) CALL DR_HOOK('TRANS_CHAINE',1,ZHOOK_HANDLE)
00070       !---------------
00071 
00072 END SUBROUTINE TRANS_CHAINE