| 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*90 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 |
|---|
