| 1 | C |
|---|
| 2 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
|---|
| 3 | C IMPRESSIONS DES RESULTATS DU PROGRAMME ** ANL ** |
|---|
| 4 | C SUBROUTINES APPELEES : HISTOG |
|---|
| 5 | C |
|---|
| 6 | C |
|---|
| 7 | C IMPRESSIONS DES TABLEAUX DES FREQUENCES |
|---|
| 8 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
|---|
| 9 | C |
|---|
| 10 | subroutine impanl(tab,anu1,anu2,impr,ymoyd,ymaxd,alf,qq,ibase) |
|---|
| 11 | C |
|---|
| 12 | logical*1 jdh(75),qq(1) |
|---|
| 13 | integer tab(1),hist(nbclas,1),msot(20),nsot(20),vers |
|---|
| 14 | real nu1,nu2,pas(2),alf(1 ) |
|---|
| 15 | CBB passage en double precision |
|---|
| 16 | real*8 ymoyd(1 ),ymaxd(1 ),yymoyd |
|---|
| 17 | real ymoy(1 ),ymax(1 ),xmin,xmax |
|---|
| 18 | character*9 trs1,trs2 |
|---|
| 19 | character*7 form,bin |
|---|
| 20 | character*4 tir,code,ctlg,mole,blanc |
|---|
| 21 | character*3 pgm,ianl,iext,itrs,ilst,icop,info,icre, |
|---|
| 22 | & iinf,oui,liste,iopt,modif,trans |
|---|
| 23 | character*2 ikod,icod |
|---|
| 24 | character*1 ba,bl,ast,ch5,ch6 |
|---|
| 25 | C |
|---|
| 26 | common/p1/ nu1,nu2,dnu,nbclas,khist,kanal,vers,mode,liste |
|---|
| 27 | common/p2/ mole(75),isot(100),nbi(75),nbt(75),iopt,ctlg,trans, |
|---|
| 28 | & trs1,trs2 |
|---|
| 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/p5/ code(75),nn(150),nq(150),ikod(18),icod(18),jdeb(75) |
|---|
| 32 | common/inteh/ incr,pas1,pmax |
|---|
| 33 | common/entsor/iuni,juni,kuni,ient,isor,iper,nresv,maxx,blanc,oui |
|---|
| 34 | C |
|---|
| 35 | equivalence (jdh(1),msot(1)) |
|---|
| 36 | C |
|---|
| 37 | data bl,ast,tir /' ','*','----'/,icar/45/,iinf/'inf'/ |
|---|
| 38 | C |
|---|
| 39 | if(mode.eq.1) pgm=iinf |
|---|
| 40 | if(impr.eq.0) write(isor,902) vers,pgm,pgm |
|---|
| 41 | 902 format(1x,17('*'),98x,17('*')/1x,'* geisa geisa *',34x, |
|---|
| 42 | &' geisa',i2.2,' contents ',35x,'* geisa geisa *'/1x, |
|---|
| 43 | &'*',6x,a3,6x,'*',98x,'*',6x,a3,6x,'*'/1x, |
|---|
| 44 | &'* geisa geisa *',38x,'analysis per molecule',39x, |
|---|
| 45 | &'* geisa geisa *'/1x,17('*'),98x,17('*')/) |
|---|
| 46 | if(impr.eq.0.and.dnu.gt.0.) write(isor,903) nu1,nu2,dnu |
|---|
| 47 | 903 format(37x,'nu1=',f10.3,' at nu2=',f10.3,' by step of dnu=' |
|---|
| 48 | &,f12.6/) |
|---|
| 49 | molj=0 |
|---|
| 50 | do 12 j=1,ntab |
|---|
| 51 | molj=molj+tab(j) |
|---|
| 52 | 12 continue |
|---|
| 53 | write(isor,1000) anu1,anu2,molj |
|---|
| 54 | 1000 format(/' spectral interval (cm-1) nu1=', f09.3,2x,'nu2=',f10.3, |
|---|
| 55 | &' transitions=',i7) |
|---|
| 56 | impr=impr+1 |
|---|
| 57 | kk=1 |
|---|
| 58 | knn=0 |
|---|
| 59 | do 24 j=1,nmol |
|---|
| 60 | if(.not.qq(j)) go to 22 |
|---|
| 61 | C |
|---|
| 62 | C AJOUT DU 5EME CARACTERE DES MOLES CH3CL ET HCOOH L(CODE 211) |
|---|
| 63 | C H(CODE 200) |
|---|
| 64 | ch5=bl |
|---|
| 65 | ch6=bl |
|---|
| 66 | if(j.eq.34) ch5='l' |
|---|
| 67 | if(j.eq.37) ch5='h' |
|---|
| 68 | if(j.eq.42) ch5='o' |
|---|
| 69 | if(j.eq.42) ch6='2' |
|---|
| 70 | kn=nn(kk) |
|---|
| 71 | ki=kk+1 |
|---|
| 72 | kf=kk+kn |
|---|
| 73 | kx=0 |
|---|
| 74 | C |
|---|
| 75 | C ELIMINATION DES ISOTOPES DE FREQUENCE NULLE |
|---|
| 76 | C MSOT ET NSOT TABLEAUX CONTENANT POUR UNE MOLECULE DONNEE |
|---|
| 77 | C LES CODES ISOTOPES ET LES FREQUENCES DES ISOTOPES |
|---|
| 78 | C ORDONNES ET A VALEURS NON NULLES |
|---|
| 79 | C |
|---|
| 80 | molj=0 |
|---|
| 81 | do 202 jk=ki,kf |
|---|
| 82 | nnt=tab(nn(jk)) |
|---|
| 83 | nnsot=nn(jk) |
|---|
| 84 | C |
|---|
| 85 | C |
|---|
| 86 | C DANS LE TABLEAU TAB LES INDICES 951 A 990 SONT RESERVES POUR |
|---|
| 87 | C LES ISOTOPES DUPLIQUES |
|---|
| 88 | C |
|---|
| 89 | C BB 06.05.97 cas de C2H4 2 isotopes dupliques, le 2eme indice=ibase=950 |
|---|
| 90 | C |
|---|
| 91 | C H2O CO2 O3 N2O CO CH4 O2 NO SO2 NO2 NH3 PH3 |
|---|
| 92 | go to (541, 541,541, 541, 541, 541, 541, 541, 509, 510, 541, 541, |
|---|
| 93 | C HNO3 OH HF HCL HBR HI CLO OCS H2CO C2H6 CH3D C2H2 |
|---|
| 94 | & 541, 541, 541, 541, 517, 518, 519, 541, 541, 541, 541, 541, |
|---|
| 95 | C C2H4 GEH4 HCN C3H8 C2N2 C4H2 HC3N HOCL N2 CH3CL H2O2 H2S |
|---|
| 96 | & 525, 526, 541, 528, 541, 530, 531, 541, 541, 541, 541, 536, |
|---|
| 97 | C HCOOH COF2 SF6 C3H4 HO2 CLONO2 |
|---|
| 98 | & 541, 541, 541, 541, 537, 541 ),j |
|---|
| 99 | C |
|---|
| 100 | C SO2 |
|---|
| 101 | 509 continue |
|---|
| 102 | if(nnsot.eq.626) nnt=tab(ibase+j) |
|---|
| 103 | go to 541 |
|---|
| 104 | C |
|---|
| 105 | C NO2 |
|---|
| 106 | 510 continue |
|---|
| 107 | if(nnsot.eq.646) nnt=tab(ibase+j) |
|---|
| 108 | go to 541 |
|---|
| 109 | C |
|---|
| 110 | C HBR |
|---|
| 111 | 517 continue |
|---|
| 112 | if(nnsot.eq. 19) nnt=tab(ibase+j) |
|---|
| 113 | go to 541 |
|---|
| 114 | C |
|---|
| 115 | C HI |
|---|
| 116 | 518 continue |
|---|
| 117 | if(nnsot.eq. 17) nnt=tab(ibase+j) |
|---|
| 118 | go to 541 |
|---|
| 119 | C |
|---|
| 120 | C CLO |
|---|
| 121 | 519 continue |
|---|
| 122 | if(nnsot.eq. 56) nnt=tab(ibase+j) |
|---|
| 123 | go to 541 |
|---|
| 124 | C |
|---|
| 125 | C C2H4 |
|---|
| 126 | 525 continue |
|---|
| 127 | if(nnsot.eq.211) nnt=tab(ibase+j) |
|---|
| 128 | if(nnsot.eq.311) nnt=tab(ibase) |
|---|
| 129 | go to 541 |
|---|
| 130 | C |
|---|
| 131 | C GEH4 |
|---|
| 132 | 526 continue |
|---|
| 133 | if(nnsot.eq.411) nnt=tab(ibase+j) |
|---|
| 134 | go to 541 |
|---|
| 135 | C |
|---|
| 136 | C C3H8 |
|---|
| 137 | 528 continue |
|---|
| 138 | if(nnsot.eq.221) nnt=tab(ibase+j) |
|---|
| 139 | go to 541 |
|---|
| 140 | C |
|---|
| 141 | C C4H2 |
|---|
| 142 | 530 continue |
|---|
| 143 | if(nnsot.eq.211) nnt=tab(ibase+j) |
|---|
| 144 | go to 541 |
|---|
| 145 | C |
|---|
| 146 | C HC3N |
|---|
| 147 | 531 continue |
|---|
| 148 | if(nnsot.eq.124) nnt=tab(ibase+j) |
|---|
| 149 | go to 541 |
|---|
| 150 | C |
|---|
| 151 | C H2S |
|---|
| 152 | 536 continue |
|---|
| 153 | if(nnsot.eq.131) nnt=tab(ibase+j) |
|---|
| 154 | go to 541 |
|---|
| 155 | C |
|---|
| 156 | C HO2 |
|---|
| 157 | 537 continue |
|---|
| 158 | if(nnsot.eq.166) nnt=tab(ibase+j) |
|---|
| 159 | go to 541 |
|---|
| 160 | C |
|---|
| 161 | 541 continue |
|---|
| 162 | if(nnt.eq.0) go to 202 |
|---|
| 163 | kx=kx+1 |
|---|
| 164 | msot(kx)=nn(jk) |
|---|
| 165 | nsot(kx)=nnt |
|---|
| 166 | molj=molj+nnt |
|---|
| 167 | 202 continue |
|---|
| 168 | if(molj.eq.0) go to 22 |
|---|
| 169 | alfmoy=alf(j)/molj |
|---|
| 170 | if(alf(j).lt.0) alfmoy=0. |
|---|
| 171 | CBB yymoy=ymoy(j)/molj |
|---|
| 172 | yymoyd=ymoyd(j)/molj |
|---|
| 173 | kn=min0(11,kx) |
|---|
| 174 | kkn=max0(kn,knn) |
|---|
| 175 | write(isor,1001)(tir,jj=1,kkn) |
|---|
| 176 | 1001 format(1x,55(1h-),11(a4,3h---)) |
|---|
| 177 | write(isor,1002) code(j),ch5,ch6,j,(msot(jj),jj=1,kn) |
|---|
| 178 | 1002 format(' | moy.i | max.i |alpha.moy| ',a4,a1,a1,'|(',i2,') iso |
|---|
| 179 | &topes |',11(i5,' |')) |
|---|
| 180 | write(isor,1003) yymoyd,ymaxd(j),alfmoy,molj,(nsot(jj),jj=1,kn) |
|---|
| 181 | 1003 format(' |',1pd9.3,'|',1pd9.3,'|',1pe9.3,'|',i7,'|number of lines| |
|---|
| 182 | &',11(i6,'|')) |
|---|
| 183 | if(kx.le.11) go to 70 |
|---|
| 184 | C |
|---|
| 185 | C AJOUTER LES IMPRESSIONS SUIVANTES DANS LE CAS OU KX>11 |
|---|
| 186 | C |
|---|
| 187 | kn=kn+1 |
|---|
| 188 | write(isor,1005)(nsot(jj),jj=kn,kx) |
|---|
| 189 | 1005 format(31x,'|',5(i6,1h|)) |
|---|
| 190 | go to 75 |
|---|
| 191 | 70 continue |
|---|
| 192 | 75 continue |
|---|
| 193 | knn=kn |
|---|
| 194 | 22 kk=kk+nn(kk)+1 |
|---|
| 195 | 24 continue |
|---|
| 196 | write(isor,1001)(tir,jj=1,knn) |
|---|
| 197 | return |
|---|
| 198 | C |
|---|
| 199 | C |
|---|
| 200 | C IMPRESSIONS DES HISTOGRAMMES |
|---|
| 201 | C |
|---|
| 202 | entry imph(hist,xmin,xmax,pas,anu1,anu2,impr) |
|---|
| 203 | C |
|---|
| 204 | ch5=bl |
|---|
| 205 | ch6=bl |
|---|
| 206 | if(imole.eq.34) ch5='l' |
|---|
| 207 | if(imole.eq.37) ch5='h' |
|---|
| 208 | if(imole.eq.42) ch6='o' |
|---|
| 209 | if(imole.eq.42) ch6='2' |
|---|
| 210 | pas(1)=pas1 |
|---|
| 211 | lk=nbclas |
|---|
| 212 | if(impr.ne.0) go to 31 |
|---|
| 213 | C IF(IVAL.EQ.IMOLE) WRITE(ISOR,904) VERS,CODE(IMOLE) |
|---|
| 214 | C &'* GEISA *',98X,'* GEISA *'/1X, |
|---|
| 215 | if(ival.eq.imole) |
|---|
| 216 | &write(isor,904) vers,pgm,pgm,code(imole),ch5,ch6 |
|---|
| 217 | 904 format(1x,17('*'),98x,17('*')/1x,'* geisa geisa *',34x, |
|---|
| 218 | &'geisa',i2.2,' cumulative frequencies ',32x,'* geisa geisa *'/ |
|---|
| 219 | &1x,'*',6x,a3,6x,'*',98x,'*',6x,a3,6x,'*'/1x, |
|---|
| 220 | &'* geisa geisa *',41x,'molecule /',a4,a1,a1,'/',40x, |
|---|
| 221 | &'* geisa geisa *'/1x,17('*'),98x,17('*')/) |
|---|
| 222 | C IF(IVAL.NE.IMOLE) WRITE(ISOR,905) VERS,CODE(IMOLE),IVAL |
|---|
| 223 | C &'* GEISA *',98X,'* GEISA *'/1X, |
|---|
| 224 | if(ival.ne.imole) |
|---|
| 225 | &write(isor,905) vers,pgm,pgm,code(imole),ch5,ch6,ival |
|---|
| 226 | 905 format(1x,17('*'),98x,17('*')/1x,'* geisa geisa *',34x, |
|---|
| 227 | &'geisa',i2.2,' cumulative frequencies ',32x,'* geisa geisa *'/ |
|---|
| 228 | &1x,'*',6x,a3,6x,'*',98x,'*',6x,a3,6x,'*'/1x, |
|---|
| 229 | &'* geisa geisa *',34x,'molecule /',a4,a1,a1,'/ isotope /', |
|---|
| 230 | &i3,'/',33x,'* geisa geisa *'/1x,17('*'),98x,17('*')/) |
|---|
| 231 | if(dnu.gt.0.) write(isor,903) nu1,nu2,dnu |
|---|
| 232 | 31 continue |
|---|
| 233 | ki=1 |
|---|
| 234 | kf=2 |
|---|
| 235 | if(khist.eq.1) kf=1 |
|---|
| 236 | if(khist.eq.2) ki=2 |
|---|
| 237 | do 35 k=ki,kf |
|---|
| 238 | mm=0 |
|---|
| 239 | do 26 j=1,lk |
|---|
| 240 | ijk=hist(j,k) |
|---|
| 241 | mm=max0(mm,ijk) |
|---|
| 242 | 26 continue |
|---|
| 243 | if(mm.ne.0) go to 27 |
|---|
| 244 | impr=impr+1 |
|---|
| 245 | if(imole.eq.ival) |
|---|
| 246 | & write(isor,900) anu1,anu2,code(imole),ch5,ch6 |
|---|
| 247 | if(imole.ne.ival) |
|---|
| 248 | & write(isor,901) anu1,anu2,ival,code(imole),ch5,ch6 |
|---|
| 249 | 900 format(///' *anl* in the spectral interval ',f10.3,'< nu <', |
|---|
| 250 | &f10.3,' the molecule ',a4,a1,a1,' does not exist'///) |
|---|
| 251 | 901 format(///' *anl* in the spectral interval ',f10.3,'< nu <', |
|---|
| 252 | &f10.3,' the isotope ',i4,' of ',a4,a1,a1,' does not exist'///) |
|---|
| 253 | return |
|---|
| 254 | 27 continue |
|---|
| 255 | ech=mm/float(icar) |
|---|
| 256 | C |
|---|
| 257 | C CALCUL DES HAUTEURS DES CLASSES DE HIST |
|---|
| 258 | C |
|---|
| 259 | do 30 j=1,lk |
|---|
| 260 | i=hist(j ,k)/ech |
|---|
| 261 | hist(j,k+2)=min0(i,icar) |
|---|
| 262 | 30 continue |
|---|
| 263 | 35 continue |
|---|
| 264 | lk1=lk+1 |
|---|
| 265 | impr=impr+1 |
|---|
| 266 | if(khist.eq.-1) go to 50 |
|---|
| 267 | k=khist |
|---|
| 268 | v=xmax |
|---|
| 269 | if(k.eq.1) v=pmax |
|---|
| 270 | if(k.eq.1.and.ival.eq.imole) write(isor,906) anu1,anu2,code(imole) |
|---|
| 271 | &,ch5,ch6 |
|---|
| 272 | 906 format(/' spectral interval (cm-1) nu1=',f10.3,5x,'nu2=',f10.3/ |
|---|
| 273 | &1x,' classes effectives intensity - ',a4,a1,a1/) |
|---|
| 274 | if(k.eq.2.and.ival.eq.imole) write(isor,907) anu1,anu2,code(imole) |
|---|
| 275 | &,ch5,ch6 |
|---|
| 276 | 907 format(/' spectral interval (cm-1) nu1=',f10.3,5x,'nu2=',f10.3/ |
|---|
| 277 | &1x,' classes effectives ground level - ',a4,a1,a1/) |
|---|
| 278 | if(k.eq.1.and.ival.ne.imole) |
|---|
| 279 | &write(isor,9061) anu1,anu2,code(imole),ch5,ch6,ival |
|---|
| 280 | 9061 format(/' spectral intarval (cm-1) nu1=',f10.3,5x,'nu2=',f10.3/ |
|---|
| 281 | &1x,' classes effectives intensity - ',a4,a1,a1,'/',i3/) |
|---|
| 282 | if(k.eq.2.and.ival.ne.imole) |
|---|
| 283 | &write(isor,9071) anu1,anu2,code(imole),ch5,ch6,ival |
|---|
| 284 | 9071 format(/' spectral interval l(cm-1) nu1=',f10.3,5x,'nu2=',f10.3/ |
|---|
| 285 | &1x,' classes effectives ground level - ',a4,a1,a1,'/',i3/) |
|---|
| 286 | if(k.eq.1) lk1=lk |
|---|
| 287 | do 40 j=1,lk1 |
|---|
| 288 | call histog(hist,pas(k),xmin,k,lk,j,ih,ihh,v,vv,ba,bl,ast) |
|---|
| 289 | write(isor,2000) vv,ihh,(ba,jj=1,ih) |
|---|
| 290 | 2000 format(1h , 1pd10.4,i7,3h|*|,45a1) |
|---|
| 291 | 40 continue |
|---|
| 292 | return |
|---|
| 293 | 50 continue |
|---|
| 294 | if(ival.eq.imole) write(isor,908) |
|---|
| 295 | &anu1,anu2,anu1,anu2,code(imole),ch5,ch6,code(imole),ch5,ch6 |
|---|
| 296 | 908 format(/' intervalle spectral(cm-1) nu1=',f10.3,5x,'nu2=',f10.3, |
|---|
| 297 | &6x,'spectral interval (cm-1) nu1=',f10.3,5x,'nu2=',f10.3/ |
|---|
| 298 | &1x,' classes effectives intensity - ',a4,a1,a1,24x ,' classes |
|---|
| 299 | & effectives ground level - ',a4,a1,a1/) |
|---|
| 300 | if(ival.ne.imole) write(isor,909) |
|---|
| 301 | &anu1,anu2,anu1,anu2,code(imole),ch5,ch6,ival,code(imole),ch5,ch6, |
|---|
| 302 | &ival |
|---|
| 303 | 909 format(/' intervalle spectral(cm-1) nu1=',f10.3,5x,'nu2=',f10.3, |
|---|
| 304 | &6x,'spectral interval (cm-1) nu1=',f10.3,5x,'nu2=',f10.3/ |
|---|
| 305 | &1x,' classes effectives intensity - ',a4,a1,a1,'/',i3,20x, |
|---|
| 306 | &' classes effectives ground level - ',a4,a1,a1,'/',i3/) |
|---|
| 307 | v=pmax |
|---|
| 308 | v1=xmax |
|---|
| 309 | do 60 j=1,lk |
|---|
| 310 | icon=1 |
|---|
| 311 | call histog(hist,pas(1),xmin,icon,lk,j,ih,ihh,v,vv,ba,bl,ast) |
|---|
| 312 | write(isor,2000) vv,ihh,(ba,jj=1,ih) |
|---|
| 313 | icon=2 |
|---|
| 314 | call histog(hist,pas(2),xmin,icon,lk,j,ih1,ihh1,v1,vv1,ba,bl,ast) |
|---|
| 315 | write(isor,2001) vv1,ihh1,(ba,jj=1,ih1) |
|---|
| 316 | 2001 format(1x,67x,1pd10.4,i7,3h|*|,45a1) |
|---|
| 317 | 60 continue |
|---|
| 318 | call histog(hist,pas(2),xmin,2,lk,lk+1,ih1,ihh1,v1,vv1,ba,bl,ast) |
|---|
| 319 | vv=vv*pas1 |
|---|
| 320 | write(isor,2002) vv,vv1,ihh1,(ba,jj=1,ih1) |
|---|
| 321 | 2002 format(1x,1pd10.4,6x,4h0|*|,47x,1pd10.4,i7,3h|*|,45a1) |
|---|
| 322 | return |
|---|
| 323 | end |
|---|
| 324 | |
|---|
