SUBROUTINE CTOI(CHAR,LEN,INTEG,ERROR) CTOI1.5
IMPLICIT NONE CTOI1.6
! Description: CTOI1.7
! CTOI1.8
! Method: CTOI1.9
! CTOI1.10
! Current code owner: S.J.Swarbrick CTOI1.11
! CTOI1.12
! History: CTOI1.13
! Version Date Comment CTOI1.14
! ======= ==== ======= CTOI1.15
! 3.5 Mar. 95 Original code. S.J.Swarbrick CTOI1.16
! 4.5 Jul. 98 Change call to INTRFACE with call to C_MDI GAV0F405.8
! (A Van der Wal) GAV0F405.9
! CTOI1.17
! Code description: CTOI1.18
! FORTRAN 77 + common Fortran 90 extensions. CTOI1.19
! Written to UM programming standards version 7. CTOI1.20
! CTOI1.21
! System component covered: CTOI1.22
! System task: Sub-Models Project CTOI1.23
! CTOI1.24
! Global variables: CTOI1.25
CTOI1.26
*CALL C_MDI 
GAV0F405.10
CTOI1.28
! Subroutine arguments: CTOI1.29
CTOI1.30
! Scalar arguments with intent(in): CTOI1.31
CTOI1.32
INTEGER LEN CTOI1.33
CTOI1.34
! Scalar arguments with intent(out): CTOI1.35
CTOI1.36
CHARACTER*1 CHAR(LEN) CTOI1.37
CHARACTER*8 ERROR CTOI1.38
INTEGER INTEG CTOI1.39
INTEGER IFIRST CTOI1.40
INTEGER ILAST CTOI1.41
INTEGER IMULT CTOI1.42
INTEGER IPOS CTOI1.43
CTOI1.44
! Local Scalars: CTOI1.45
CTOI1.46
LOGICAL LBLANK CTOI1.47
INTEGER I CTOI1.48
INTEGER IDIGIT CTOI1.49
CTOI1.50
!- End of Header ------------------------------------------------------ CTOI1.51
CTOI1.52
INTEG=IMDI GAV0F405.11
ERROR=' ' CTOI1.54
ILAST=LEN CTOI1.55
C CTOI1.56
IFIRST=0 CTOI1.57
IPOS=1 CTOI1.58
LBLANK=.TRUE. CTOI1.59
DO 100 I=1,LEN CTOI1.60
IF((CHAR(I).NE.'0').AND. CTOI1.61
& (CHAR(I).NE.'1').AND. CTOI1.62
& (CHAR(I).NE.'2').AND. CTOI1.63
& (CHAR(I).NE.'3').AND. CTOI1.64
& (CHAR(I).NE.'4').AND. CTOI1.65
& (CHAR(I).NE.'5').AND. CTOI1.66
& (CHAR(I).NE.'6').AND. CTOI1.67
& (CHAR(I).NE.'7').AND. CTOI1.68
& (CHAR(I).NE.'8').AND. CTOI1.69
& (CHAR(I).NE.'9').AND. CTOI1.70
& (CHAR(I).NE.' ')) THEN CTOI1.71
C ILLEGAL CHARACTER IN INTEGER CTOI1.72
ERROR='M109 ' CTOI1.73
RETURN CTOI1.74
ELSE CTOI1.75
IF(CHAR(I).EQ.' ') THEN CTOI1.76
IF(IPOS.EQ.2) ILAST=I-1 CTOI1.77
IF(.NOT.LBLANK) THEN CTOI1.78
IPOS=IPOS+1 CTOI1.79
LBLANK=.TRUE. CTOI1.80
IF(IPOS.GT.3) THEN CTOI1.81
C ILLEGAL INTEGER CTOI1.82
ERROR='M109 ' CTOI1.83
RETURN CTOI1.84
END IF CTOI1.85
END IF CTOI1.86
ELSE CTOI1.87
IF(IPOS.EQ.1) IFIRST=I CTOI1.88
IF(LBLANK) THEN CTOI1.89
IPOS=IPOS+1 CTOI1.90
LBLANK=.FALSE. CTOI1.91
IF(IPOS.GT.3) THEN CTOI1.92
C ILLEGAL INTEGER CTOI1.93
ERROR='M109 ' CTOI1.94
RETURN CTOI1.95
END IF CTOI1.96
END IF CTOI1.97
END IF CTOI1.98
END IF CTOI1.99
100 CONTINUE CTOI1.100
C CTOI1.101
INTEG=0 CTOI1.102
IMULT=1 CTOI1.103
DO 200 I=ILAST,IFIRST,-1 CTOI1.104
READ(CHAR(I),210) IDIGIT CTOI1.105
210 FORMAT(I1) CTOI1.106
INTEG=INTEG+IDIGIT*IMULT CTOI1.107
IMULT=IMULT*10 CTOI1.108
200 CONTINUE CTOI1.109
RETURN CTOI1.110
END CTOI1.111
*ENDIF CTOI1.112