root / src / upcase.f90 @ 1
Historique | Voir | Annoter | Télécharger (506 octet)
| 1 | 1 | pfleura2 | SUBROUTINE Upcase(String) |
|---|---|---|---|
| 2 | 1 | pfleura2 | |
| 3 | 1 | pfleura2 | ! This subroutine converts a string into its Upcase |
| 4 | 1 | pfleura2 | ! version |
| 5 | 1 | pfleura2 | |
| 6 | 1 | pfleura2 | integer, parameter :: KINT = kind(1) |
| 7 | 1 | pfleura2 | integer, parameter :: KREAL = kind(1.0d0) |
| 8 | 1 | pfleura2 | |
| 9 | 1 | pfleura2 | CHARACTER(*), INTENT(INOUT) :: String |
| 10 | 1 | pfleura2 | INTEGER(KINT) :: i,ic, length |
| 11 | 1 | pfleura2 | length=len_trim(string) |
| 12 | 1 | pfleura2 | DO I=1, length |
| 13 | 1 | pfleura2 | ic=ICHAR(String(i:i)) |
| 14 | 1 | pfleura2 | if ((ic.ge.97).and.(ic.le.122)) ic=ic-32 |
| 15 | 1 | pfleura2 | String(i:i)=ACHAR(ic) |
| 16 | 1 | pfleura2 | END DO |
| 17 | 1 | pfleura2 | |
| 18 | 1 | pfleura2 | RETURN |
| 19 | 1 | pfleura2 | END SUBROUTINE Upcase |