1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
|
**==map.f processed by SPAG 4.03F at 09:51 on 1 Mar 1994
SUBROUTINE map(Frcset,Tocset,Str1,Str2)
IMPLICIT NONE
c----------------------------------------------------------------------
c Maps fromcset characters to tocset characters within the domain
c of fromcset and copies otherwise.
c----------------------------------------------------------------------
INCLUDE 'lex.i'
c -----------------------------------------------------------------
CHARACTER Frcset*(*),Tocset*(*),Str1*(*),Str2*(*)
INTEGER ichr,indx,mapind
EXTERNAL indx
c -----------------------------------------------------------------
IF(len(Frcset).ne.len(Tocset))THEN
CALL inpter(PERROR,Pos,'Map cset''s not the same length')
c -----------------------------------------------------------------
ELSE IF(len(Str2).lt.len(Str1))THEN
CALL inpter(PERROR,Pos,'Map output string not long enough')
c -----------------------------------------------------------------
ELSE
Str2=Str1
c -----------------------------------------------------------------
DO ichr=1,len(Str1)
mapind=indx(Frcset,Str1(ichr:ichr))
IF(mapind.gt.0)Str2(ichr:ichr)=Tocset(mapind:mapind)
END DO
END IF
c -----------------------------------------------------------------
RETURN
END
|
