| 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*90 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 | include 'geisafile.h' |
|---|
| 40 | C |
|---|
| 41 | len=ltrim(filename_bin) |
|---|
| 42 | open(unit=kuni,access='direct',recl=11276,status='new', |
|---|
| 43 | &form='unformatted',file=filename_bin(1:len)) |
|---|
| 44 | C |
|---|
| 45 | rewind juni |
|---|
| 46 | if(mode.eq.0) go to 14 |
|---|
| 47 | C |
|---|
| 48 | C FICHIER JUNI FORMATE |
|---|
| 49 | C |
|---|
| 50 | do 10 j=1,90 |
|---|
| 51 | 10 fb(j:j)=fmc(j:j) |
|---|
| 52 | go to 22 |
|---|
| 53 | 14 continue |
|---|
| 54 | C |
|---|
| 55 | C FICHIER JUNI BINAIRE |
|---|
| 56 | C |
|---|
| 57 | do 15 j=1,6 |
|---|
| 58 | 15 fb(j:j)=fff(j:j) |
|---|
| 59 | C MIS A BLANC DU RESTE DU TABLEAU |
|---|
| 60 | do 20 j=7,80 |
|---|
| 61 | 20 fb(j:j)=fmc(6:6) |
|---|
| 62 | 22 continue |
|---|
| 63 | read (juni,fb,err=4544) (vv(kk),kk=1,24) |
|---|
| 64 | go to 4543 |
|---|
| 65 | 4544 print *,'mauvais record lu: ' |
|---|
| 66 | write(*,*) 'TT ',fb |
|---|
| 67 | write(*,fb) (vv(kk),kk=1,24) |
|---|
| 68 | c write(96,*) (vv(kk),kk=1,24) |
|---|
| 69 | 4543 nu1=vv1 |
|---|
| 70 | inte=int(nu1/dv) |
|---|
| 71 | k=1 |
|---|
| 72 | kq=0 |
|---|
| 73 | 25 continue |
|---|
| 74 | read (juni,fb,end=30,err=4444) (vv(kk),kk=1,24) |
|---|
| 75 | go to 4441 |
|---|
| 76 | 4444 print *,'mauvais record lu(2): ' |
|---|
| 77 | write(*,fb) (vv(kk),kk=1,24) |
|---|
| 78 | C write(96,*) (vv(kk),kk=1,24) |
|---|
| 79 | 4441 jnte=int(vv1/dv) |
|---|
| 80 | if(jnte.ne.inte) go to 26 |
|---|
| 81 | k=k+1 |
|---|
| 82 | go to 25 |
|---|
| 83 | 26 continue |
|---|
| 84 | kq=kq+k/n203+1 |
|---|
| 85 | if(k-(k/n203)*n203.eq.0) kq=kq-1 |
|---|
| 86 | k=1 |
|---|
| 87 | inte=jnte |
|---|
| 88 | go to 25 |
|---|
| 89 | 30 continue |
|---|
| 90 | C |
|---|
| 91 | C ET CALCUL LA PLUS GRANDE FREQUENCE DU FICHIER DES RAIES JUNI |
|---|
| 92 | C |
|---|
| 93 | nu2=vv1 |
|---|
| 94 | kq=kq+k/n203+1 |
|---|
| 95 | if(k-(k/n203)*n203.eq.0) kq=kq-1 |
|---|
| 96 | C AJOUTER LA 1ERE PISTE ET LA DERNIERE PISTE A PREVOIR |
|---|
| 97 | kq=kq+2 |
|---|
| 98 | 40 continue |
|---|
| 99 | rewind juni |
|---|
| 100 | call geisad( v,v,juni,kuni,pgm,isor,fb,*130) |
|---|
| 101 | return |
|---|
| 102 | 300 continue |
|---|
| 103 | write(isor,3000) nu1,nu2 |
|---|
| 104 | 3000 format(/// ' *cre* interval : nu1=',f12.6,3x,'nu2=',f12.6) |
|---|
| 105 | 130 continue |
|---|
| 106 | return 1 |
|---|
| 107 | end |
|---|
