NLSL: writec.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

writec.f90
Go to the documentation of this file.
1 c Version 1.5.1 beta 2/3/96
2 c----------------------------------------------------------------------
3 c ====================
4 c subroutine WRITEC
5 c ====================
6 c
7 c Process "write" command. Forces writing of calculated spectra
8 c having no corresponding data
9 c
10 c----------------------------------------------------------------------
11 subroutine writec( line )
12 c
13 use nlsdim
14 use expdat
15 use parcom
16 use lmcom
17 use mspctr
18 use stdio
19 c
20 implicit none
21 character*80 line
22 c
23 integer i,j,k,l,lth
24 double precision field
25 character*40 oname
26 c
27 if (written.eq.0) call wrspc()
28 if (nspc.lt.nser) then
29 do i = nspc+1,nser
30 call gettkn( line, oname, lth )
31 if (lth.eq.0) then
32 write(luout,1000) i
33 return
34 end if
35 c
36 open(ludisk,file=oname(:lth),status='unknown',
37 # access='sequential',form='formatted',err=10)
38 field=sbi(i)
39 do j=1,npts(i)
40 k=ixsp(i)+j-1
41 c *** Multiple sites
42 if (nsite.gt.1) then
43 write(ludisk,1045,err=10) field,-fvec(k),
44 # (sfac(l,i)*spectr(k,l),l=1,nsite)
45 c
46 c *** Single site
47 else
48 write(ludisk,1045,err=10) field,-fvec(k)
49 end if
50 field=field+sdb(i)
51 end do
52 close (ludisk)
53 end do
54 end if
55 return
56 c
57 10 write (luout,1001) oname(:lth)
58 if (luout.ne.luttyo) write (luttyo,1001) oname(:lth)
59 close(ludisk)
60 return
61 c
62 c
63 1000 format('*** Output filename required for spectrum',i2,' ***')
64 1001 format('*** Error opening or writing file ''',a,''' ***')
65 1045 format(f10.3,6(' ',g14.7))
66 end
67
stdio::luout
integer, save luout
Definition: stdio.f90:32
expdat::sbi
double precision, dimension(mxspc), save sbi
Definition: expdat.f90:40
expdat::sdb
double precision, dimension(mxspc), save sdb
Definition: expdat.f90:40
expdat::ixsp
integer, dimension(mxspc), save ixsp
Definition: expdat.f90:45
mspctr::sfac
double precision, dimension(mxsite, mxspc), save sfac
Definition: mspctr.f90:33
stdio
Definition: stdio.f90:26
wrspc
subroutine wrspc()
Definition: writr.f90:93
parcom
Definition: parcom.f90:42
gettkn
subroutine gettkn(line, token, lth)
Written for free-form input of parameters for slow-motional calculations. Returns a token consisting ...
Definition: strutl1.f90:75
expdat::written
integer, save written
Definition: expdat.f90:45
expdat::nspc
integer, save nspc
Definition: expdat.f90:45
parcom::nsite
integer, save nsite
Definition: parcom.f90:62
lmcom::fvec
double precision, dimension(mxpt), save fvec
Definition: lmcom.f90:17
parcom::nser
integer, save nser
Definition: parcom.f90:62
writec
subroutine writec(line)
Definition: writec.f90:12
lmcom
Definition: lmcom.f90:13
stdio::ludisk
integer, parameter ludisk
Definition: stdio.f90:29
expdat
Definition: expdat.f90:36
stdio::luttyo
integer, parameter luttyo
Definition: stdio.f90:29
nlsdim
Definition: nlsdim.f90:36
expdat::npts
integer, dimension(mxspc), save npts
Definition: expdat.f90:45
mspctr
Definition: mspctr.f90:28
mspctr::spectr
double precision, dimension(mxpt, mxsite), save spectr
Definition: mspctr.f90:33