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 | CBB modif pour parametrer la lecture soit de la base (unit=1) soit un autre |
---|
107 | CBB fichier (unit=iuni) 29/10/1996 |
---|
108 | CBB data iuni,isor /01,6/ |
---|
109 | C |
---|
110 | C GEISA90 : 6233 -> 11276 |
---|
111 | C |
---|
112 | CBB test de iuni pour faire l open sur le bon fichier |
---|
113 | c print *,' pgeisa: iuni=',iuni |
---|
114 | len=ltrim(racine_data) |
---|
115 | write(*,*) 'racine_data ',racine_data(1:len),len |
---|
116 | if (iuni.eq.1) then |
---|
117 | open (unit=1,access='direct',recl=11276, |
---|
118 | c &file='/users4/armante/GEISA_NEW/LxL/Data/Geisa97/geisa97_old') |
---|
119 | c &file='/users4/armante/GEISA_NEW/LxL/Data/Geisa97new/geisa97') |
---|
120 | &file=racine_data(1:len)//'/geisa97') |
---|
121 | else |
---|
122 | c print *,' pgeisa2: iuni=',iuni |
---|
123 | open (unit=iuni,access='direct',recl=11276) |
---|
124 | endif |
---|
125 | CBB fin du test 29/10/96 |
---|
126 | C |
---|
127 | C RECHERCHE DE LA PREMIERE TRANSITION A LIRE |
---|
128 | C IDEB=ADRESSE DE LA TRANSITION DANS LE VECTEUR V |
---|
129 | C V VECTEUR QUI CONTIENT TOUTES LES TRANSITIONS D'UN BLOC |
---|
130 | C |
---|
131 | invers=.false. |
---|
132 | c print *,' pgeisa: read rec1 ' |
---|
133 | if(u1.gt.u2) invers=.true. |
---|
134 | read (iuni,rec=1) |
---|
135 | &aa1,aa2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4 |
---|
136 | c print *,'aa1=',aa1,' aa2=',aa2,' n203=',n203,' nbraie=',nbraie |
---|
137 | c *,' iecr=',iecr,' ifin=',ifin,' ll1=',ll1,' ll2=',ll2,' ll3=', |
---|
138 | c *ll3,' ll4=',ll4 |
---|
139 | nmol=nbmol |
---|
140 | c vers=ll3 |
---|
141 | v1=amax1(u1,aa1) |
---|
142 | v2=amin1(u2,aa2) |
---|
143 | w2=amin1(u1,aa2) |
---|
144 | w1=amax1(u2,aa1) |
---|
145 | iadr=int(v1/anu) + 2 - int(aa1/anu) |
---|
146 | if(invers.and.w1.ge.w2) go to 70 |
---|
147 | if(.not.invers.and.v1.gt.v2) go to 70 |
---|
148 | if(.not.invers) go to 1 |
---|
149 | v1=w2 |
---|
150 | w2=w1 |
---|
151 | iadr=int(w2/anu) + 2 - int(aa1/anu) |
---|
152 | 1 continue |
---|
153 | go to 5 |
---|
154 | C partie inutile ( trace des users connectes via la proc geisa du CIRCE |
---|
155 | if(ll1.eq.0.or.ll2.eq.0.or.nfff.eq.1.or.ll4.lt.0) go to 5 |
---|
156 | C |
---|
157 | C VALEURS RETOURNEES |
---|
158 | C 1 - 8 NOM |
---|
159 | C 9 - 15 SIGLE NUM |
---|
160 | C 16 BLANC |
---|
161 | C 17 -19 ADRESSE TERMINAL |
---|
162 | C 20 -24 DATE XXYYY |
---|
163 | C 25 -32 HEURE HHMMSSDC |
---|
164 | C |
---|
165 | kpgm=ipgm |
---|
166 | if(npgx.ge.1.and.npgx.le.8) kpgm=mpgx |
---|
167 | C |
---|
168 | if(kpgm.ne.ipgm) go to 7 |
---|
169 | do 6 j=1,nmol |
---|
170 | qqq(j)=.true. |
---|
171 | 6 continue |
---|
172 | 7 continue |
---|
173 | C |
---|
174 | C |
---|
175 | C VB CONTIENT 32+NMOL OCTETS : |
---|
176 | C 1 - 8 NOM |
---|
177 | C 9 - 15 SIGLE NUM |
---|
178 | C 16 - 20 DATE XXYYY |
---|
179 | C 21 - 24 NU1 |
---|
180 | C 25 - 28 NU2 |
---|
181 | C 29 - 32 PGM |
---|
182 | C 33 - 32+NMOL NMOL OCTETS PRESENCE ABSENCE MOLECULE |
---|
183 | C |
---|
184 | nfff=1 |
---|
185 | do 2 j=20,24 |
---|
186 | vb(j-4)=vb(j) |
---|
187 | 2 continue |
---|
188 | vab(6)=v1 |
---|
189 | if(kpgm.eq.icop) vab(6)=nu1 |
---|
190 | vab(7)=v2 |
---|
191 | if(kpgm.eq.icop) vab(7)=nu2 |
---|
192 | do 3 j=1,nmol |
---|
193 | vb(32+j)=qqq(j) |
---|
194 | 3 continue |
---|
195 | lll=ifin+ll1+ll2+ll4 |
---|
196 | c print *,' pgeisalire: rec =lll',lll |
---|
197 | read (iuni,rec=lll) kb,longr,max,nxx,(vv(j),j=1,kb) |
---|
198 | do 4 j=1,nxx |
---|
199 | kb=kb+1 |
---|
200 | vv(kb)=vb(j) |
---|
201 | 4 continue |
---|
202 | write(iuni,rec=lll) kb,longr,max,nxx,(vv(j),j=1,kb) |
---|
203 | if(kb.lt.longr) go to 5 |
---|
204 | ll4=ll4+1 |
---|
205 | if(ll4.gt.max-1) ll4=-ll4 |
---|
206 | write(iuni,rec=1) |
---|
207 | &aa1,aa2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4 |
---|
208 | C fin de la trace utilisateurs |
---|
209 | 5 continue |
---|
210 | if(invers) go to 30 |
---|
211 | 9 continue |
---|
212 | C |
---|
213 | C RECHERCHE DE LA PREMIERE TRANSITION POUR LECTURE DIRECTE |
---|
214 | C |
---|
215 | ilec=iadr |
---|
216 | c print *,' pgeisalire: rec =iadr',iadr |
---|
217 | read (iuni,rec=ilec) iadr,jadr,k,a1,a2,a3,(v(j),j=1,k) |
---|
218 | C FIND (IUNI,REC=IADR) |
---|
219 | if(v1.gt.a1) go to 9 |
---|
220 | if(v1.gt.a3) go to 11 |
---|
221 | C |
---|
222 | C GEISA90 : 16 -> 29 |
---|
223 | C |
---|
224 | do 10 j=1,k,29 |
---|
225 | ideb=j |
---|
226 | if(v1.le.v(j)) go to 20 |
---|
227 | 10 continue |
---|
228 | 11 continue |
---|
229 | ideb=k+1 |
---|
230 | 20 continue |
---|
231 | C |
---|
232 | C GEISA90 : 16 -> 29 |
---|
233 | C |
---|
234 | ideb=ideb-29 |
---|
235 | C |
---|
236 | return |
---|
237 | C |
---|
238 | C RECHERCHE DE LA PREMIERE TRANSITION POUR LECTURE INVERSE |
---|
239 | C IDEB=ADRESSE DE LA TRANSITION DANS LE VECTEUR V |
---|
240 | C V VECTEUR QUI CONTIENT TOUTES LES TRANSITIONS D'UN BLOC |
---|
241 | C |
---|
242 | 30 continue |
---|
243 | 35 continue |
---|
244 | ilec=iadr |
---|
245 | c print *,' lecture de ilec=',ilec |
---|
246 | read (iuni,rec=ilec) iadr,jadr,k,a1,a2,a3,(v(j),j=1,k) |
---|
247 | C FIND (IUNI,REC=IADR) |
---|
248 | if(w2.gt.a1) go to 35 |
---|
249 | if(w2.gt.a3) go to 37 |
---|
250 | C |
---|
251 | C GEISA90 : 16 -> 29 |
---|
252 | C |
---|
253 | do 36 j=1,k,29 |
---|
254 | ideb=j |
---|
255 | if(w2.lt.v(j)) return |
---|
256 | 36 continue |
---|
257 | 37 continue |
---|
258 | ideb=k+1 |
---|
259 | return |
---|
260 | C |
---|
261 | C LECTURE DES TRANSITIONS |
---|
262 | C |
---|
263 | entry lgeisa(tab,*) |
---|
264 | if(invers) go to 52 |
---|
265 | C |
---|
266 | C LECTURE DES TRANSITIONS PAR ORDRE CROISSANT |
---|
267 | C |
---|
268 | 47 continue |
---|
269 | C |
---|
270 | C GEISA90 : 16 -> 29 |
---|
271 | C |
---|
272 | ideb=ideb+29 |
---|
273 | if(ideb.gt.k) go to 50 |
---|
274 | C |
---|
275 | C GEISA90 : 16 -> 29 |
---|
276 | C |
---|
277 | do 48 j=1,29 |
---|
278 | 48 tab(j)=v(ideb+j-1) |
---|
279 | if(v2.lt.v(ideb)) return 1 |
---|
280 | C |
---|
281 | C RETURN 1 SI DERNIERE TRANSITION LUE |
---|
282 | C OU SI FIN DU FICHIER RENCONTRE |
---|
283 | C |
---|
284 | return |
---|
285 | 50 continue |
---|
286 | C |
---|
287 | C TOUT LE VECTEUR V EST LU |
---|
288 | C LECTURE DU BLOC SUIVANT ET REMPLISSAGE DE V |
---|
289 | C |
---|
290 | if(iadr.eq.ifin) return 1 |
---|
291 | c print *,' lecture de iadr=',iadr |
---|
292 | read (iuni,rec=iadr) iadr,jadr,k,a1,a2,a3,(v(j),j=1,k) |
---|
293 | C FIND (IUNI,REC=IADR) |
---|
294 | C |
---|
295 | C GEISA90 : 15 -> 28 |
---|
296 | C |
---|
297 | ideb=-28 |
---|
298 | go to 47 |
---|
299 | C |
---|
300 | C LECTURE DES TRANSITIONS PAR ORDRE DECROISSANT |
---|
301 | C |
---|
302 | 52 continue |
---|
303 | C |
---|
304 | C GEISA90 : 16 -> 29 |
---|
305 | C |
---|
306 | ideb=ideb-29 |
---|
307 | if(ideb.lt.1) go to 55 |
---|
308 | C |
---|
309 | C GEISA90 : 16 -> 29 |
---|
310 | C |
---|
311 | do 54 j=1,29 |
---|
312 | 54 tab(j)=v(ideb+j-1) |
---|
313 | if(v(ideb).lt.w1) return 1 |
---|
314 | return |
---|
315 | 55 continue |
---|
316 | if(jadr.eq.1) return 1 |
---|
317 | c print *,' lecture de jadr=',jadr |
---|
318 | read (iuni,rec=jadr) iadr,jadr,k,a1,a2,a3,(v(j),j=1,k) |
---|
319 | C FIND (IUNI,REC=JADR) |
---|
320 | ideb=k+1 |
---|
321 | go to 52 |
---|
322 | 70 continue |
---|
323 | C |
---|
324 | C ERREUR SUR LES VALEURS NU1 ET NU2 |
---|
325 | C |
---|
326 | write(isor,1000) u1,u2,nbraie,aa1,aa2 |
---|
327 | 1000 format(///' consultation of geisa contents *** geisa ***'/ |
---|
328 | & ' verify the value of nu1=',f12.6,' and nu2=', |
---|
329 | &f12.6/' the',i8,' transitions of the spectroscopic data bank are i |
---|
330 | &n the spectral interval '/9x,'v1=',f12.6,' and v2=',f12.6///) |
---|
331 | return 1 |
---|
332 | end |
---|