SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/mode_write_cover

Go to the documentation of this file.
00001 !     ##########################
00002       MODULE MODE_WRITE_COVER_TEX
00003 !     ##########################
00004 !
00005 !-------------------------------------------------------------------------------
00006 !
00007 !
00008 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00009 USE PARKIND1  ,ONLY : JPRB
00010 !
00011 CONTAINS
00012 !
00013 !-------------------------------------------------------------------------------
00014 !
00015 FUNCTION NB (PX,KMAX)  RESULT (KNB)
00016 !
00017 IMPLICIT NONE
00018 !
00019 REAL,    INTENT(IN)            :: PX   ! real
00020 INTEGER, INTENT(IN), OPTIONAL  :: KMAX
00021 INTEGER                        :: KNB  !
00022 !
00023 INTEGER :: IMAX     ! maximum number of decimals
00024 INTEGER :: IX
00025 INTEGER :: JK
00026 INTEGER :: IDEC,IINT
00027 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00028 !
00029 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_COVER_TEX:NB',0,ZHOOK_HANDLE)
00030 IMAX=2
00031 IF (PRESENT(KMAX)) IMAX=KMAX
00032 !
00033 IINT=0
00034 !
00035 
00036 DO JK=0,8
00037   IF ( INT(PX/10**JK+1.E-7)/=0 ) IINT=IINT+1
00038 END DO
00039 !
00040 DO JK=1,4
00041   IX=INT(PX*10**IMAX+1.E-7)
00042   IF (IX==0) THEN
00043     IMAX=IMAX+1
00044   ELSE
00045     EXIT
00046   END IF
00047 END DO
00048 IF (IX==0) IMAX=2
00049 !
00050 IDEC=IMAX
00051 !
00052 DO JK=1,IMAX
00053   IF ( IX == NINT(IX/FLOAT(10**JK))*10**JK ) THEN
00054     IDEC=IDEC-1
00055   END IF
00056 END DO
00057 !
00058 KNB=MAX(IINT,1)+IDEC+1
00059 KNB=KNB+1
00060 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_COVER_TEX:NB',1,ZHOOK_HANDLE)
00061 !
00062 END FUNCTION NB
00063 !
00064 !-------------------------------------------------------------------------------
00065 !
00066 FUNCTION NBT (PX,KMAX)  RESULT (KNBT)
00067 !
00068 IMPLICIT NONE
00069 !
00070 REAL,    INTENT(IN)            :: PX   ! real
00071 INTEGER, INTENT(IN), OPTIONAL  :: KMAX
00072 INTEGER                        :: KNBT !
00073 !
00074 INTEGER :: IMAX     ! maximum number of decimals
00075 INTEGER :: IX
00076 INTEGER :: JK
00077 INTEGER :: IDEC,IINT
00078 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00079 !
00080 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_COVER_TEX:NBT',0,ZHOOK_HANDLE)
00081 IMAX=2
00082 IF (PRESENT(KMAX)) IMAX=KMAX
00083 !
00084 IINT=0
00085 !
00086 DO JK=0,8
00087   IF ( INT(PX/10.**JK+1.E-7)/=0 ) IINT=IINT+1
00088 END DO
00089 !
00090 DO JK=1,4
00091   IX=INT(PX*10**IMAX+1.E-7)
00092   IF (IX==0) THEN
00093     IMAX=IMAX+1
00094   ELSE
00095     EXIT
00096   END IF
00097 END DO
00098 IF (IX==0) IMAX=2
00099 !
00100 IDEC=IMAX
00101 !
00102 DO JK=1,IMAX
00103   IF ( IX == NINT(IX/FLOAT(10**JK))*10**JK ) THEN
00104     IDEC=IDEC-1
00105   END IF
00106 END DO
00107 !
00108 KNBT=MAX(IINT+IDEC+1,2)
00109 KNBT=KNBT+1
00110 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_COVER_TEX:NBT',1,ZHOOK_HANDLE)
00111 !
00112 END FUNCTION NBT
00113 !
00114 !-------------------------------------------------------------------------------
00115 !
00116 FUNCTION DEC (PX,KMAX) RESULT (KDEC)
00117 !
00118 IMPLICIT NONE
00119 !
00120 REAL,    INTENT(IN)            :: PX   ! real
00121 INTEGER, INTENT(IN), OPTIONAL  :: KMAX
00122 INTEGER                        :: KDEC ! number of decimals of PX
00123 !
00124 INTEGER :: IMAX     ! maximum number of decimals
00125 INTEGER :: IX
00126 INTEGER :: JK
00127 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00128 !
00129 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_COVER_TEX:DEC',0,ZHOOK_HANDLE)
00130 IMAX=2
00131 IF (PRESENT(KMAX)) IMAX=KMAX
00132 !
00133 !
00134 DO JK=1,4
00135   IX=INT(PX*10**IMAX+1.E-7)
00136   IF (IX==0) THEN
00137     IMAX=IMAX+1
00138   ELSE
00139     EXIT
00140   END IF
00141 END DO
00142 IF (IX==0) IMAX=2
00143 !
00144 KDEC=IMAX
00145 !
00146 DO JK=1,IMAX
00147   IF ( IX == NINT(IX/FLOAT(10**JK))*10**JK ) THEN
00148     KDEC=KDEC-1
00149   END IF
00150 END DO
00151 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_COVER_TEX:DEC',1,ZHOOK_HANDLE)
00152 !
00153 !
00154 END FUNCTION DEC
00155 !-------------------------------------------------------------------------------
00156 SUBROUTINE HLINE(KTEX,GLINE,I)
00157 !
00158 IMPLICIT NONE
00159 !
00160 INTEGER, INTENT(IN)    :: KTEX  ! logical unit
00161 LOGICAL, INTENT(INOUT) :: GLINE ! flag to write one line
00162 INTEGER, INTENT(IN)    :: I     ! line number
00163 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00164 
00165   IF (LHOOK) CALL DR_HOOK('MODE_WRITE_COVER_TEX:HLINE',0,ZHOOK_HANDLE)
00166   IF ((I==3 .OR. I==  7 .OR. I==  9 .OR. I==15  .OR. I== 23 .OR. I== 24 &
00167               .OR. I== 28 .OR. I== 33 .OR. I==47  .OR. I== 66 .OR. I== 79 &
00168               .OR. I== 87 .OR. I==104 .OR. I==122 .OR. I==123 .OR. I==125 &
00169               .OR. I==161 .OR. I==173 .OR. I==176 .OR. I==181 .OR. I==186 &
00170               .OR. I==191 .OR. I==197 .OR. I==198 .OR. I==207 .OR. I==214 &
00171               .OR. I==219 .OR. I==225 .OR. I==229 .OR. I==232 .OR. I==235 &
00172               .OR. I==241 .OR. I==243                                    )&
00173              .AND. GLINE ) THEN  
00174     WRITE(KTEX,*) '\hline'
00175     GLINE=.FALSE.
00176   END IF
00177 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_COVER_TEX:HLINE',1,ZHOOK_HANDLE)
00178 END SUBROUTINE HLINE
00179 !-------------------------------------------------------------------------------
00180 END MODULE MODE_WRITE_COVER_TEX