1 | C CETTE OPTION PERMET DE TRIER UN FICHIER DE NUMERO LOGIQUE JUNI |
---|
2 | C LE RESULTAT TRIE EST PLACE SUR LE FICHIER *** SORTOUT *** |
---|
3 | C A PREVOIR DANS LES CARTES CONTROLES |
---|
4 | C |
---|
5 | C SI LE FICHIER A TRIER EST FORMATTE PREVOIR UNE CARTE DD |
---|
6 | C DE NUMERO LOGIQUE JUNI+1 POUR UNE COPIE PROVISOIRE BINAIRE |
---|
7 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
---|
8 | C |
---|
9 | subroutine trif(juni,isor,pgm,mode,vers,*) |
---|
10 | C |
---|
11 | character*132 fnt |
---|
12 | character*112 fml |
---|
13 | character*80 fmc,fb |
---|
14 | character*44 fmt |
---|
15 | character*6 fff |
---|
16 | character*3 pgm |
---|
17 | dimension a(29) |
---|
18 | integer vers |
---|
19 | C |
---|
20 | common/ffff/ fml,fmc,fmt,fnt,fff |
---|
21 | C |
---|
22 | equivalence (a(15),isot),(a(16),imol) |
---|
23 | C |
---|
24 | luni=juni+1 |
---|
25 | write(isor,1000) pgm,pgm,vers |
---|
26 | 1000 format(1x,17('*'),98x,17('*')/1x,'* geisa geisa *', |
---|
27 | &31x,' spectroscopic data bank ',32x, |
---|
28 | &'* geisa geisa *'/' *',6x,a3,6x,'*',98x,'*',6x,a3,6x,'*'/ |
---|
29 | &' * geisa geisa *',26x,15x,'*** geisa',i2.2,' ***',16x, |
---|
30 | & 26x,'* geisa geisa *'/1x,17('*'),98x,17('*')/ |
---|
31 | & 1x,33x,'management and study of atmospheric spectroscopic |
---|
32 | &informations') |
---|
33 | write(isor,2000) juni |
---|
34 | 2000 format(//1x,45x,'sort of file refered by juni=',i2//) |
---|
35 | if(mode.eq.0) go to 20 |
---|
36 | C |
---|
37 | C FICHIER A TRIER FORMATE |
---|
38 | C |
---|
39 | do 10 j=1,80 |
---|
40 | 10 fb(j:j)=fmc(j:j) |
---|
41 | c fb(7:7)=fmc(6:6) |
---|
42 | c print *,' formate:',fb |
---|
43 | go to 40 |
---|
44 | 20 continue |
---|
45 | C |
---|
46 | C FICHIER A TRIER BINAIRE |
---|
47 | do 30 j=1,6 |
---|
48 | 30 fb(j:j)=fff(j:j) |
---|
49 | C MIS A BLANC DU RESTE DU TABLEAU |
---|
50 | do 31 j=7,80 |
---|
51 | 31 fb(j:j)=fmc(6:6) |
---|
52 | c print *,'Uformate:',fb |
---|
53 | 40 continue |
---|
54 | l=0 |
---|
55 | 50 continue |
---|
56 | read (juni,fb,end=60) a |
---|
57 | l=l+1 |
---|
58 | write(luni) a |
---|
59 | go to 50 |
---|
60 | 60 continue |
---|
61 | write(isor,3000) l |
---|
62 | 3000 format(/' total number of records sorted : ',i6) |
---|
63 | rewind luni |
---|
64 | c return |
---|
65 | C |
---|
66 | c call tri('*sort fields=(5,4,fl,a,9,4,fl,a)*' |
---|
67 | c & ,'*record type=v*',irc) |
---|
68 | call system ("sort -b -n -t: -k.1,.4 -k.5,.8 ") |
---|
69 | c &-o fort.11 fort.11 ") |
---|
70 | C |
---|
71 | if(irc.eq.0) write(isor,3010) l |
---|
72 | 3010 format(/' ',i6,' records has been sorted successfully'//) |
---|
73 | if(irc.ne.0) write(isor,3020) |
---|
74 | 3020 format(/' step sort ended normaly '/) |
---|
75 | return |
---|
76 | end |
---|