diff options
Diffstat (limited to 'width/inpwidth.for')
| -rw-r--r-- | width/inpwidth.for | 218 |
1 files changed, 218 insertions, 0 deletions
diff --git a/width/inpwidth.for b/width/inpwidth.for new file mode 100644 index 0000000..b7058c8 --- /dev/null +++ b/width/inpwidth.for @@ -0,0 +1,218 @@ + program inpwidth + character*10 label,labelp,other1,other2 + character*80 card,star,end,stop,mol1,mol2,hlin,begin + character*80 modfile,c,linefile + character*4 ref + character*5 modcard + dimension vts(3),angle(20) + data end/'END'/ + data stop/'STOP'/ + data mol1/'MOLECULES ON'/ + data mol2/'READ MOLECULES'/ + data hlin/'OPACITY ON HLINES'/ + data begin/'BEGIN'/ + data label/' '/ + data labelp/' '/ + data other1/' '/ + data other2/' '/ + nblo=0 + npup=0 + iso1=0 + x1=0. + iso2=0 + x2=0. + open(unit=2,file='inplines.dat',status='unknown') + open(unit=1,status='new') + open(unit=10,status='old',readonly,shared,recl=160) + open(unit=11,status='old',readonly,shared,recl=160) + open(unit=12,status='old',readonly,shared,recl=160) + open(unit=13,status='old',readonly,shared,recl=160) + open(unit=14,status='old',readonly,shared,recl=160) + open(unit=15,status='old',readonly,shared,recl=160) + open(unit=16,status='old',readonly,shared,recl=160) + open(unit=17,status='old',readonly,shared,recl=160) + open(unit=18,status='old',readonly,shared,recl=160) + type 311 +311 format(3x,'star name ',$) + accept 90,star + type 1 +1 format(3x,'VTUR(bulence)? (yes=1/no=0) ',$) + accept*,iturb + if(iturb.eq.1) go to 10 +100 type 2 +2 format(3x,'PROF(ile)? (yes=1/no=0) ',$) + accept*,iprof + if(iprof.eq.1) go to 20 +200 type 3 +3 format(3x,'AVER(age)? (yes=1/no=0) ',$) + accept*, iaver + if (iaver.eq.1) go to 30 +300 type 4 +4 format(3x,'CURV(e)? (yes=1/no=0) ',$) + accept*,icurv + if(icurv.eq.1) go to 40 +400 type 5 +5 format(3x,'end of data for the lines? (yes=1/no=0) ',$) + accept*,iend + if(iend.eq.1) go to 500 +600 type 6 +6 format(3x,'stop ? (yes=1/no=0) ',$) + accept*, istop + if(istop.eq.1) go to 60 +10 card='VTUR' + write (1,90) card +90 format(a) + type 11 +11 format(3x,'Number N of the microturb. velocities (NMAX=3): ',$) + accept*,nvt + type 12 +12 format(3x,'Type the values of the N microturb. velocities ',$) + accept*,(vts(ivt),ivt=1,nvt) + write(1,91) nvt,(vts(ivt),ivt=1,nvt) +91 format(i5,3f5.2) + iwhat=1 + type 14 +14 format(3x,'Is some line file already existing?(yes=1/no=0) ',$) + accept*,iold + if(iold.eq.0) go to 66 + 667 read(2,190,end=66)card + 190 format(a4) + if(card.eq.'AVER')then + write(1,190)card + go to 667 + endif + if(card.eq.'LINE')then + read(2,874)wlobs + read(2,874)ew + write(1,9)card,ew,wlobs,star + read(2,874)gflog + read(2,911)ref + read(2,874)xj + read(2,8745)e + read(2,874)xjp + read(2,8745)ep + read(2,874)code + 8745 format(1x,f12.3) + wl=wlobs + write(1,444)wl,gflog,xj,e,xjp,ep,code,label,labelp + read(2,875)nelion + read(2,874)gammar + read(2,874)gammas + read(2,874)gammaw + read(2,873)alpha + 873 format(f6.3) + write(1,445)wl,nelion,gammar,gammas,gammaw,ref,nblo,nbup,iso1, + 1 x1,iso2,x2,other1,other2,alpha + go to 667 + endif +66 type 13 +13 format(3x,'LINE ? (yes=1/no=0) ',$) + accept*,iline + if(iline.eq.1) go to 50 + if(iwhat.eq.3) GO TO 200 + go to (100,200,300,400),iwhat +20 card='PROF' + write(1,90) card + write(2,90)card + iwhat=2 + go to 66 +30 card='AVER' + write(1,90) card + write(2,90)card + iwhat=3 + go to 66 +40 card='CURV' + write(1,90) card + write(2,90)card + type 41 +41 format(3x,'type nablog,minlog,dablog'/3x,$) + accept*,nablog,fminlog,dablog + write(1,171) nablog,fminlog,dablog +171 format(i5,2f8.2) + iwhat=4 + go to 66 + 50 card='LINE' + write(2,190)card + type 31 +31 format(3x,'wavelength (in Nm: es. 4000A=400.0 Nm): ', $) + accept*,wlobs + write(2,874) wlobs +874 format(1x,f10.4) + type 131 +131 format(3x,'equivalent width (in Pm: es. 200 mA=20.0 Pm): ',$) + accept*,ew + write(2,874)ew + card='LINE' + write(1,9) card,ew,wlobs,star +9 format(a4,f10.2,f10.4,1x,a56) + type 3227 +3227 format(3x,'code ',$) + accept*,code1 + if(wlobs.lt.100)unit=10 + if(wlobs.ge.100.and.wlobs.lt.150.)unit=11 + if(wlobs.ge.150.and.wlobs.lt.200.)unit=12 + if(wlobs.ge.200.and.wlobs.lt.300.)unit=13 + if(wlobs.ge.300.and.wlobs.lt.400.)unit=14 + if(wlobs.ge.400.and.wlobs.lt.500.)unit=15 + if(wlobs.ge.500.and.wlobs.lt.600.)unit=16 + if(wlobs.ge.600.and.wlobs.lt.800.)unit=17 + if(wlobs.ge.800.)unit=18 + do 900 iline=1,50000000 + read(unit,140,end=500)wl,gflog,code,e,xj,label,ep,xjp,labelp, + 1 gammar,gammas,gammaw,ref,nblo,nbup,iso1,x1,iso2,x2,other1, + 2 other2,lande,landeg,isoshift,alpha + 140 format(f11.4,f7.3,f6.2,f12.3,f5.1,1x,a10,f12.3,f5.1,1x,a10, + 1 f6.2,f6.2,f6.2,a4,i2,i2,i3,f6.3,i3,f6.3,a10,a10,2i5,i6,f6.3) +c + if(abs(wl-wlobs).le.0.002.and.code.eq.code1)then + write(1,444) wl,gflog,xj,e,xjp,ep,code,label,labelp +444 format(f10.4,f7.3,f5.1,f12.3,f5.1,f12.3,f9.2,a10,a10) + nelem=code + icharge=(code-float(nelem))*100+0.1 + zeff=icharge+1 + nelion=nelem*6-6+ifix(zeff) + write(1,445)wl,nelion,gammar,gammas,gammaw,ref,nblo,nbup,iso1, + 1 x1,iso2,x2,other1,other2,alpha +445 format(f10.4,i4,f6.2,f6.2,f6.2,a4,i2,i2,i3,f7.3,i3,f7.3, + 1 a10,a10,f6.3) + write(2,874)gflog + write(2,911)ref +911 format(a4) + write(2,874)xj + write(2,8745)e + write(2,874)xjp + write(2,8745)ep + write(2,874)code +9011 format(a10) + write(2,875)nelion +875 format(1x,i5) + write(2,874)gammar + write(2,874) gammas + write(2,874)gammaw + write(2,873)alpha + rewind(unit) + go to 66 + endif + 900 continue +500 write(1,90) end +83 type 503 +503 format(///,3x,'type the name of the model file ',$) + accept 90,modfile + open(unit=3,file=modfile,status='old') + do 993 i=1,500 + read (3,90,end=999) c + write(modcard,'(a5)')c(1:5) +c type 342, modcard + 342 format(1x,a5) + if (modcard.ne.begin)write (1,90)c +993 continue + 999 close (unit=3) + write(1,90)mol1 + write(1,90)mol2 + write(1,90)hlin + write(1,90)begin +60 write(1,90)end + write(1,90)stop + close(unit=1) + stop + end |