1 | C FORMAT='BINAIRE' SI LE FICHIER A LIRE EST EN BINAIRE(PAR DEFAUT) |
---|
2 | C 'FORMATE' SI LE FICHIER A LIRE EST EN FORMATE |
---|
3 | C JUNI=NUMERO LOGIQUE DU FICHIER A LIRE (PAR DEFAUT 10) |
---|
4 | C |
---|
5 | C EN SORTIE LE NUMERO LOGIQUE DU FICHIER CREE EST KUNI=2 |
---|
6 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
---|
7 | C |
---|
8 | C LAST MODIF : 06.05.1991 PASSAGE DE 40 A 75 MOLECULES DANS LES COMMON |
---|
9 | C |
---|
10 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
---|
11 | subroutine creat(v,*) |
---|
12 | C |
---|
13 | character*132 fnt |
---|
14 | character*112 fml |
---|
15 | character*80 fmc,fb |
---|
16 | character*44 fmt |
---|
17 | character*7 form,bin |
---|
18 | character*6 fff |
---|
19 | character*4 blanc |
---|
20 | character*3 pgm,ianl,iext,itrs,ilst,icop,info,icre,liste, |
---|
21 | & modif,iasr,remp,supp,ajou,oui |
---|
22 | integer vers |
---|
23 | C |
---|
24 | C GEISA90 : 16 -> 29 |
---|
25 | C |
---|
26 | real nu1,nu2,v(1),vv(29) |
---|
27 | C |
---|
28 | common/p1/ nu1,nu2,dnu,nbclas,khist,kanal,vers,mode,liste |
---|
29 | common/p3/ imole,iran,ival,pgm,ianl,iext,itrs,ilst,icop,info,icre |
---|
30 | common/p4/ nmol,knmol,ksot,kksot,ntab,nhist,kp,lre,form,bin,modif |
---|
31 | common/p6/ iasr,remp,supp,ajou,imp8,imp9,in40,in41,in42,in43,n97 |
---|
32 | common/ffff/ fml,fmc,fmt,fnt,fff |
---|
33 | common/entsor/iuni,juni,kuni,ient,isor,iper,nresv,maxx,blanc,oui |
---|
34 | C |
---|
35 | equivalence (vv(1),vv1) |
---|
36 | equivalence (n203,n97) |
---|
37 | C |
---|
38 | data dv/100./ |
---|
39 | C |
---|
40 | open(unit=kuni,access='direct',recl=11276,status='new', |
---|
41 | &form='unformatted') |
---|
42 | C |
---|
43 | rewind juni |
---|
44 | if(mode.eq.0) go to 14 |
---|
45 | C |
---|
46 | C FICHIER JUNI FORMATE |
---|
47 | C |
---|
48 | do 10 j=1,80 |
---|
49 | 10 fb(j:j)=fmc(j:j) |
---|
50 | go to 22 |
---|
51 | 14 continue |
---|
52 | C |
---|
53 | C FICHIER JUNI BINAIRE |
---|
54 | C |
---|
55 | do 15 j=1,6 |
---|
56 | 15 fb(j:j)=fff(j:j) |
---|
57 | C MIS A BLANC DU RESTE DU TABLEAU |
---|
58 | do 20 j=7,80 |
---|
59 | 20 fb(j:j)=fmc(6:6) |
---|
60 | 22 continue |
---|
61 | read (juni,fb,err=4544) (vv(kk),kk=1,24) |
---|
62 | go to 4543 |
---|
63 | 4544 print *,'mauvais record lu: ' |
---|
64 | write(*,fb) (vv(kk),kk=1,24) |
---|
65 | c write(96,*) (vv(kk),kk=1,24) |
---|
66 | 4543 nu1=vv1 |
---|
67 | inte=int(nu1/dv) |
---|
68 | k=1 |
---|
69 | kq=0 |
---|
70 | 25 continue |
---|
71 | read (juni,fb,end=30,err=4444) (vv(kk),kk=1,24) |
---|
72 | go to 4441 |
---|
73 | 4444 print *,'mauvais record lu(2): ' |
---|
74 | write(*,fb) (vv(kk),kk=1,24) |
---|
75 | C write(96,*) (vv(kk),kk=1,24) |
---|
76 | 4441 jnte=int(vv1/dv) |
---|
77 | if(jnte.ne.inte) go to 26 |
---|
78 | k=k+1 |
---|
79 | go to 25 |
---|
80 | 26 continue |
---|
81 | kq=kq+k/n203+1 |
---|
82 | if(k-(k/n203)*n203.eq.0) kq=kq-1 |
---|
83 | k=1 |
---|
84 | inte=jnte |
---|
85 | go to 25 |
---|
86 | 30 continue |
---|
87 | C |
---|
88 | C ET CALCUL LA PLUS GRANDE FREQUENCE DU FICHIER DES RAIES JUNI |
---|
89 | C |
---|
90 | nu2=vv1 |
---|
91 | kq=kq+k/n203+1 |
---|
92 | if(k-(k/n203)*n203.eq.0) kq=kq-1 |
---|
93 | C AJOUTER LA 1ERE PISTE ET LA DERNIERE PISTE A PREVOIR |
---|
94 | kq=kq+2 |
---|
95 | 40 continue |
---|
96 | rewind juni |
---|
97 | call geisad( v,v,juni,kuni,pgm,isor,fb,*130) |
---|
98 | return |
---|
99 | 300 continue |
---|
100 | write(isor,3000) nu1,nu2 |
---|
101 | 3000 format(/// ' *cre* interval : nu1=',f12.6,3x,'nu2=',f12.6) |
---|
102 | 130 continue |
---|
103 | return 1 |
---|
104 | end |
---|