| 1 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
|---|
| 2 | C PGEISA - LGEISA |
|---|
| 3 | C |
|---|
| 4 | C CALL PGEISA(NU1,NU2,&ETIQ1) |
|---|
| 5 | C CALL LGEISA(A,&ETIQ2) |
|---|
| 6 | C |
|---|
| 7 | C SUBROUTINES DE LECTURE DE LA BANQUE DES DONNEES SPECTROSCOPIQUES |
|---|
| 8 | C |
|---|
| 9 | C PGEISA POSITIONNE LA LECTURE |
|---|
| 10 | C |
|---|
| 11 | C LGEISA LIT LES CARACTERISTIQUES D'UNE TRANSITION |
|---|
| 12 | C SEQUENTIELLEMENT DANS L'ORDRE NU1 A NU2 |
|---|
| 13 | C NU1>NU2 NU1=NU2 NU1<NU2 |
|---|
| 14 | C |
|---|
| 15 | C LE FICHIER DES DONNEES DOIT ETRE *** FT01F001 *** |
|---|
| 16 | C |
|---|
| 17 | C NU1 ET NU2 LIMITES DES RAIES A LIRE |
|---|
| 18 | C A VECTEUR A 29 VALEURS DONT 26 DE REMPLIES: |
|---|
| 19 | C A(1)=RAIE ; A(2)=INTENSITE ; A(3)=DEMI-LARGEUR ; A(4)=ENERGIE ; |
|---|
| 20 | C A(5)-A(13)=NOMBRES QUANTIQUES ; A(14)= ; |
|---|
| 21 | C A(15)=CODE ISOTOPE ; A(16)=CODE MOLECULE. |
|---|
| 22 | C A(15) - A(16) SONT DES VARIABLES ENTIERES. |
|---|
| 23 | C FAIRE PAR EXEMPLE EQUIVALENCE (A(15),ISOT),(A(16),IMOL) |
|---|
| 24 | C A(17)= CODE AUTEUR ; |
|---|
| 25 | C |
|---|
| 26 | C ETIQ1 ETIQUETTE A PREVOIR POUR UNE SORTIE EN ERREUR DE PGEISA |
|---|
| 27 | C ETIQ2 ETIQUETTE A PREVOIR POUR UNE SORTIE EN FIN DE LECTURE |
|---|
| 28 | C EN ETIQ2 LE VECTEUR A CONTIENDRA LA TRANSITION |
|---|
| 29 | C SUIVANT NU2 (LECTURE DIRECTE) ET PRECEDANT NU2 (INVERSE) |
|---|
| 30 | C |
|---|
| 31 | C REMARQUE : PGEISA DOIT ETRE APPELE IMMEDIATEMENT AVANT LGEISA |
|---|
| 32 | C |
|---|
| 33 | C |
|---|
| 34 | C CONTENU DU PREMIER BLOC : |
|---|
| 35 | C AA1,AA2,ANU,N203,NBRAIE,NBMOL,IECR,IFIN,LL1,LL2,LL3,LL4,LL5 |
|---|
| 36 | C |
|---|
| 37 | C AA1=PREMIERE TRANSITION |
|---|
| 38 | C AA2=DERNIERE TRANSITION |
|---|
| 39 | C ANU=PAS DU BLOCAGE DES TRANSITIONS (PAR GROUPE DE 100 CM-1) |
|---|
| 40 | C AU MAXIMUM N203=97 ENREGISTREMENTS PAR PISTE |
|---|
| 41 | C NBRAIE=NOMBRE TOTAL DE TRANSITIONS DANS LE FICHIER |
|---|
| 42 | C NBMOL=NOMBRE DE MOLECULES DECLAREES DANS LE PROGRAMME |
|---|
| 43 | C IECR=NUMERO DERNIER BLOC ECRIT |
|---|
| 44 | C IFIN=NUMERO BLOC A ECRIRE (EN CONTINUATION) A PREVOIR PHYSIQUEMENT |
|---|
| 45 | C |
|---|
| 46 | C LL1=NB DE RECORDS OU SONT STOCKEES LES INFORMATIONS CONCERNANT TRS |
|---|
| 47 | C SOIT : IFIN,IFIN+1,IFIN+2,...,IFIN+LL1-1 |
|---|
| 48 | C |
|---|
| 49 | C LL2=1 LES INFORMATIONS CONCERNANT ANL EXISTENT SUR IFIN+LL1 |
|---|
| 50 | C LL2=0 SINON |
|---|
| 51 | C |
|---|
| 52 | C LL3=NUMERO VERSION DE LA BANQUE |
|---|
| 53 | C LL4=INCREMENT POUR ADRESSAGE RECORD RENSEIGNEMENTS UTILISATEURS |
|---|
| 54 | C LL4=0,1,2,...,MAX-1 |
|---|
| 55 | C LL5=4 SELON DISQUE 3380 |
|---|
| 56 | C ADRESSE RECORD=IFIN+LL1+LL2+LL4 |
|---|
| 57 | C FORMAT RECORD : KB,LONGR,MAX,NXX,(VV(J),J=1,KB) |
|---|
| 58 | C |
|---|
| 59 | C A PARTIR DU RECORD IFIN+LL1+LL2 SONT STOCKEES LES INFORMATIONS |
|---|
| 60 | C CONCERNANT L'UTILISATION DE LA BANQUE |
|---|
| 61 | C |
|---|
| 62 | C |
|---|
| 63 | C CONTENU D'UN BLOC>1 |
|---|
| 64 | C IADR,JADR,K,A1,A2,A3,(V(J),J=1,K) |
|---|
| 65 | C IADR=ADRESSE DU BLOC SUIVANT A LIRE |
|---|
| 66 | C JADR=ADRESSE DU BLOC PRECEDENT QUI A ETE LU |
|---|
| 67 | C A1=PREMIERE VALEUR DE NU DANS LE BLOC SUIVANT |
|---|
| 68 | C A2=DERNIERE VALEUR DE NU DANS LE BLOC PRECEDENT |
|---|
| 69 | C A3=DERNIERE VALEUR DE NU DANS LE BLOC ACTUEL |
|---|
| 70 | C V(1)=PREMIERE VALEUR DE NU DANS LE BLOC ACTUEL |
|---|
| 71 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
|---|
| 72 | C |
|---|
| 73 | C LAST MODIF : 07.05.1991 PASSAGE DE 40 MOLECULES A 75 DANS LES COMMON |
|---|
| 74 | C |
|---|
| 75 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
|---|
| 76 | C |
|---|
| 77 | subroutine pgeisa(u1,u2,*) |
|---|
| 78 | C |
|---|
| 79 | C SI L'APPEL VIENT DES PROGRAMMES GEISA |
|---|
| 80 | C MPGX='ANL','EXT',.... |
|---|
| 81 | C NPGX=1,2,...,8 |
|---|
| 82 | C |
|---|
| 83 | character*7 form,bin |
|---|
| 84 | character*3 liste,pgm,ianl,iext,itrs,ilst,icop,info,icre, |
|---|
| 85 | & modif,mpgx,ipgm,kpgm |
|---|
| 86 | logical*1 vb(107),vv(06233),qqq,invers |
|---|
| 87 | integer vers |
|---|
| 88 | real nu1,nu2 |
|---|
| 89 | C |
|---|
| 90 | C GEISA90 : 1552 -> 2813 |
|---|
| 91 | C |
|---|
| 92 | dimension tab(29),v(2813),vab(13) |
|---|
| 93 | C |
|---|
| 94 | common/p1/ nu1,nu2,dnu,nbclas,khist,kanal,vers,mode,liste |
|---|
| 95 | common/p3/ imole,iran,ival,pgm,ianl,iext,itrs,ilst,icop,info,icre |
|---|
| 96 | common/p4/ nmol,knmol,ksot,kksot,ntab,nhist,kp,lre,form,bin,modif |
|---|
| 97 | common/p8/ npgx,nfff,mpgx,qqq(75) |
|---|
| 98 | CBB modif: ajout du common ensor pour initialiser iuni |
|---|
| 99 | common/entsor/iuni,juni |
|---|
| 100 | CBB fin modif 29/10/96 |
|---|
| 101 | C |
|---|
| 102 | equivalence (kpgm,vb(29)),(v(1),vv(1)),(vab(1),vb(1)) |
|---|
| 103 | C |
|---|
| 104 | data ipgm/'lec'/,invers,ideb/.false.,0/ |
|---|
| 105 | include 'geisafile.h' |
|---|
| 106 | |
|---|
| 107 | len=ltrim(racine_data) |
|---|
| 108 | filename_asc=racine_data(1:len)//'/line_GEISA2003_asc_gs_v1.0' |
|---|
| 109 | filename_bin=racine_data(1:len)//'/line_GEISA2003_bin_gs_v1.0' |
|---|
| 110 | CBB modif pour parametrer la lecture soit de la base (unit=1) soit un autre |
|---|
| 111 | CBB fichier (unit=iuni) 29/10/1996 |
|---|
| 112 | CBB data iuni,isor /01,6/ |
|---|
| 113 | C |
|---|
| 114 | C GEISA90 : 6233 -> 11276 |
|---|
| 115 | C |
|---|
| 116 | CBB test de iuni pour faire l open sur le bon fichier |
|---|
| 117 | c print *,' pgeisa: iuni=',iuni |
|---|
| 118 | if (iuni.eq.1) then |
|---|
| 119 | len=ltrim(filename_bin) |
|---|
| 120 | open (unit=1,access='direct',recl=11276, |
|---|
| 121 | c &file='/usr/local/datageisa/data/geisa97') |
|---|
| 122 | c &file='/users6/geisa/Database/line_GEISA2003_bin_gs_v1.0') |
|---|
| 123 | &file=filename_bin(1:len)) |
|---|
| 124 | else |
|---|
| 125 | c print *,' pgeisa2: iuni=',iuni |
|---|
| 126 | open (unit=iuni,access='direct',recl=11276) |
|---|
| 127 | endif |
|---|
| 128 | CBB fin du test 29/10/96 |
|---|
| 129 | C |
|---|
| 130 | C RECHERCHE DE LA PREMIERE TRANSITION A LIRE |
|---|
| 131 | C IDEB=ADRESSE DE LA TRANSITION DANS LE VECTEUR V |
|---|
| 132 | C V VECTEUR QUI CONTIENT TOUTES LES TRANSITIONS D'UN BLOC |
|---|
| 133 | C |
|---|
| 134 | invers=.false. |
|---|
| 135 | c print *,' pgeisa: read rec1 ' |
|---|
| 136 | if(u1.gt.u2) invers=.true. |
|---|
| 137 | read (iuni,rec=1) |
|---|
| 138 | &aa1,aa2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4 |
|---|
| 139 | c print *,'aa1=',aa1,' aa2=',aa2,' n203=',n203,' nbraie=',nbraie |
|---|
| 140 | c *,' iecr=',iecr,' ifin=',ifin,' ll1=',ll1,' ll2=',ll2,' ll3=', |
|---|
| 141 | c *ll3,' ll4=',ll4 |
|---|
| 142 | nmol=nbmol |
|---|
| 143 | vers=ll3 |
|---|
| 144 | v1=amax1(u1,aa1) |
|---|
| 145 | v2=amin1(u2,aa2) |
|---|
| 146 | w2=amin1(u1,aa2) |
|---|
| 147 | w1=amax1(u2,aa1) |
|---|
| 148 | iadr=int(v1/anu) + 2 - int(aa1/anu) |
|---|
| 149 | if(invers.and.w1.ge.w2) go to 70 |
|---|
| 150 | if(.not.invers.and.v1.gt.v2) go to 70 |
|---|
| 151 | if(.not.invers) go to 1 |
|---|
| 152 | v1=w2 |
|---|
| 153 | w2=w1 |
|---|
| 154 | iadr=int(w2/anu) + 2 - int(aa1/anu) |
|---|
| 155 | 1 continue |
|---|
| 156 | go to 5 |
|---|
| 157 | C partie inutile ( trace des users connectes via la proc geisa du CIRCE |
|---|
| 158 | if(ll1.eq.0.or.ll2.eq.0.or.nfff.eq.1.or.ll4.lt.0) go to 5 |
|---|
| 159 | C |
|---|
| 160 | C VALEURS RETOURNEES |
|---|
| 161 | C 1 - 8 NOM |
|---|
| 162 | C 9 - 15 SIGLE NUM |
|---|
| 163 | C 16 BLANC |
|---|
| 164 | C 17 -19 ADRESSE TERMINAL |
|---|
| 165 | C 20 -24 DATE XXYYY |
|---|
| 166 | C 25 -32 HEURE HHMMSSDC |
|---|
| 167 | C |
|---|
| 168 | kpgm=ipgm |
|---|
| 169 | if(npgx.ge.1.and.npgx.le.8) kpgm=mpgx |
|---|
| 170 | C |
|---|
| 171 | if(kpgm.ne.ipgm) go to 7 |
|---|
| 172 | do 6 j=1,nmol |
|---|
| 173 | qqq(j)=.true. |
|---|
| 174 | 6 continue |
|---|
| 175 | 7 continue |
|---|
| 176 | C |
|---|
| 177 | C |
|---|
| 178 | C VB CONTIENT 32+NMOL OCTETS : |
|---|
| 179 | C 1 - 8 NOM |
|---|
| 180 | C 9 - 15 SIGLE NUM |
|---|
| 181 | C 16 - 20 DATE XXYYY |
|---|
| 182 | C 21 - 24 NU1 |
|---|
| 183 | C 25 - 28 NU2 |
|---|
| 184 | C 29 - 32 PGM |
|---|
| 185 | C 33 - 32+NMOL NMOL OCTETS PRESENCE ABSENCE MOLECULE |
|---|
| 186 | C |
|---|
| 187 | nfff=1 |
|---|
| 188 | do 2 j=20,24 |
|---|
| 189 | vb(j-4)=vb(j) |
|---|
| 190 | 2 continue |
|---|
| 191 | vab(6)=v1 |
|---|
| 192 | if(kpgm.eq.icop) vab(6)=nu1 |
|---|
| 193 | vab(7)=v2 |
|---|
| 194 | if(kpgm.eq.icop) vab(7)=nu2 |
|---|
| 195 | do 3 j=1,nmol |
|---|
| 196 | vb(32+j)=qqq(j) |
|---|
| 197 | 3 continue |
|---|
| 198 | lll=ifin+ll1+ll2+ll4 |
|---|
| 199 | c print *,' pgeisalire: rec =lll',lll |
|---|
| 200 | read (iuni,rec=lll) kb,longr,max,nxx,(vv(j),j=1,kb) |
|---|
| 201 | do 4 j=1,nxx |
|---|
| 202 | kb=kb+1 |
|---|
| 203 | vv(kb)=vb(j) |
|---|
| 204 | 4 continue |
|---|
| 205 | write(iuni,rec=lll) kb,longr,max,nxx,(vv(j),j=1,kb) |
|---|
| 206 | if(kb.lt.longr) go to 5 |
|---|
| 207 | ll4=ll4+1 |
|---|
| 208 | if(ll4.gt.max-1) ll4=-ll4 |
|---|
| 209 | write(iuni,rec=1) |
|---|
| 210 | &aa1,aa2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4 |
|---|
| 211 | C fin de la trace utilisateurs |
|---|
| 212 | 5 continue |
|---|
| 213 | if(invers) go to 30 |
|---|
| 214 | 9 continue |
|---|
| 215 | C |
|---|
| 216 | C RECHERCHE DE LA PREMIERE TRANSITION POUR LECTURE DIRECTE |
|---|
| 217 | C |
|---|
| 218 | ilec=iadr |
|---|
| 219 | c print *,' pgeisalire: rec =iadr',iadr |
|---|
| 220 | read (iuni,rec=ilec) iadr,jadr,k,a1,a2,a3,(v(j),j=1,k) |
|---|
| 221 | C FIND (IUNI,REC=IADR) |
|---|
| 222 | if(v1.gt.a1) go to 9 |
|---|
| 223 | if(v1.gt.a3) go to 11 |
|---|
| 224 | C |
|---|
| 225 | C GEISA90 : 16 -> 29 |
|---|
| 226 | C |
|---|
| 227 | do 10 j=1,k,29 |
|---|
| 228 | ideb=j |
|---|
| 229 | if(v1.le.v(j)) go to 20 |
|---|
| 230 | 10 continue |
|---|
| 231 | 11 continue |
|---|
| 232 | ideb=k+1 |
|---|
| 233 | 20 continue |
|---|
| 234 | C |
|---|
| 235 | C GEISA90 : 16 -> 29 |
|---|
| 236 | C |
|---|
| 237 | ideb=ideb-29 |
|---|
| 238 | C |
|---|
| 239 | return |
|---|
| 240 | C |
|---|
| 241 | C RECHERCHE DE LA PREMIERE TRANSITION POUR LECTURE INVERSE |
|---|
| 242 | C IDEB=ADRESSE DE LA TRANSITION DANS LE VECTEUR V |
|---|
| 243 | C V VECTEUR QUI CONTIENT TOUTES LES TRANSITIONS D'UN BLOC |
|---|
| 244 | C |
|---|
| 245 | 30 continue |
|---|
| 246 | 35 continue |
|---|
| 247 | ilec=iadr |
|---|
| 248 | c print *,' lecture de ilec=',ilec |
|---|
| 249 | read (iuni,rec=ilec) iadr,jadr,k,a1,a2,a3,(v(j),j=1,k) |
|---|
| 250 | C FIND (IUNI,REC=IADR) |
|---|
| 251 | if(w2.gt.a1) go to 35 |
|---|
| 252 | if(w2.gt.a3) go to 37 |
|---|
| 253 | C |
|---|
| 254 | C GEISA90 : 16 -> 29 |
|---|
| 255 | C |
|---|
| 256 | do 36 j=1,k,29 |
|---|
| 257 | ideb=j |
|---|
| 258 | if(w2.lt.v(j)) return |
|---|
| 259 | 36 continue |
|---|
| 260 | 37 continue |
|---|
| 261 | ideb=k+1 |
|---|
| 262 | return |
|---|
| 263 | C |
|---|
| 264 | C LECTURE DES TRANSITIONS |
|---|
| 265 | C |
|---|
| 266 | entry lgeisa(tab,*) |
|---|
| 267 | if(invers) go to 52 |
|---|
| 268 | C |
|---|
| 269 | C LECTURE DES TRANSITIONS PAR ORDRE CROISSANT |
|---|
| 270 | C |
|---|
| 271 | 47 continue |
|---|
| 272 | C |
|---|
| 273 | C GEISA90 : 16 -> 29 |
|---|
| 274 | C |
|---|
| 275 | ideb=ideb+29 |
|---|
| 276 | if(ideb.gt.k) go to 50 |
|---|
| 277 | C |
|---|
| 278 | C GEISA90 : 16 -> 29 |
|---|
| 279 | C |
|---|
| 280 | do 48 j=1,29 |
|---|
| 281 | 48 tab(j)=v(ideb+j-1) |
|---|
| 282 | if(v2.lt.v(ideb)) return 1 |
|---|
| 283 | C |
|---|
| 284 | C RETURN 1 SI DERNIERE TRANSITION LUE |
|---|
| 285 | C OU SI FIN DU FICHIER RENCONTRE |
|---|
| 286 | C |
|---|
| 287 | return |
|---|
| 288 | 50 continue |
|---|
| 289 | C |
|---|
| 290 | C TOUT LE VECTEUR V EST LU |
|---|
| 291 | C LECTURE DU BLOC SUIVANT ET REMPLISSAGE DE V |
|---|
| 292 | C |
|---|
| 293 | if(iadr.eq.ifin) return 1 |
|---|
| 294 | c print *,' lecture de iadr=',iadr |
|---|
| 295 | read (iuni,rec=iadr) iadr,jadr,k,a1,a2,a3,(v(j),j=1,k) |
|---|
| 296 | C FIND (IUNI,REC=IADR) |
|---|
| 297 | C |
|---|
| 298 | C GEISA90 : 15 -> 28 |
|---|
| 299 | C |
|---|
| 300 | ideb=-28 |
|---|
| 301 | go to 47 |
|---|
| 302 | C |
|---|
| 303 | C LECTURE DES TRANSITIONS PAR ORDRE DECROISSANT |
|---|
| 304 | C |
|---|
| 305 | 52 continue |
|---|
| 306 | C |
|---|
| 307 | C GEISA90 : 16 -> 29 |
|---|
| 308 | C |
|---|
| 309 | ideb=ideb-29 |
|---|
| 310 | if(ideb.lt.1) go to 55 |
|---|
| 311 | C |
|---|
| 312 | C GEISA90 : 16 -> 29 |
|---|
| 313 | C |
|---|
| 314 | do 54 j=1,29 |
|---|
| 315 | 54 tab(j)=v(ideb+j-1) |
|---|
| 316 | if(v(ideb).lt.w1) return 1 |
|---|
| 317 | return |
|---|
| 318 | 55 continue |
|---|
| 319 | if(jadr.eq.1) return 1 |
|---|
| 320 | c print *,' lecture de jadr=',jadr |
|---|
| 321 | read (iuni,rec=jadr) iadr,jadr,k,a1,a2,a3,(v(j),j=1,k) |
|---|
| 322 | C FIND (IUNI,REC=JADR) |
|---|
| 323 | ideb=k+1 |
|---|
| 324 | go to 52 |
|---|
| 325 | 70 continue |
|---|
| 326 | C |
|---|
| 327 | C ERREUR SUR LES VALEURS NU1 ET NU2 |
|---|
| 328 | C |
|---|
| 329 | write(isor,1000) u1,u2,nbraie,aa1,aa2 |
|---|
| 330 | 1000 format(///' consultation of geisa contents *** geisa ***'/ |
|---|
| 331 | & ' verify the value of nu1=',f12.6,' and nu2=', |
|---|
| 332 | &f12.6/' the',i8,' transitions of the spectroscopic data bank are i |
|---|
| 333 | &n the spectral interval '/9x,'v1=',f12.6,' and v2=',f12.6///) |
|---|
| 334 | return 1 |
|---|
| 335 | end |
|---|
