c*********** Interactive transformation code from JPDOC ************ c * c This Fortran code reads the data from a standard file of JPDOC, * c in an interactive way learns what data and in what format should * c be printed, and creates the corresponding output file. * c * c 1998 Oct, V.I. * c******************************************************************* parameter (ma=25) character*1 aa(ma), ef, yn character*25 in, out dimension a (9,80) common /aaa/aa data h /6.62e-27/, c /3.0e+10/, ev /1.602e-12/ c--- input and output filenames print *, ' ' print *, ' Please, specify the input file name: ' read (*, 31) in 31 format (a25) print *, ' ' print *, ' Please, specify the output file name: ' read (*, 31) out open (unit=08, file=in, status='old', access='sequential') open (unit=09, file=out, status='new', access='sequential') c--- the head of standard file do 2 i = 1, 9 2 read (8, 7) (a(i,j), j = 1, 80) 7 format (80a1) c do 4 i = 1, 6 c 4 write (9, 7) (a(i,j), j = 1, 80) c--- questions on output quantities print *,' Specify output function ' print *,' (give 1 for refractive index,' print *,' 2 for dielectric function):' print *,' ' read (5, 5) mode1 5 format (i4) print *,' Specify its argument ' print *,' (give 1 for wavelength (cm),' print *,' 2 for energy (eV),' print *,' 3 for wavenumber (cm-1)):' print *,' ' read (5,5) mode2 c--- questions on output formats print *,' Specify output format: ' c--- first number: wavelength, etc. 43 continue print *, ' ' print *, ' 1. column: wavelength/energy/wavenumber' print *, ' Specify format type (E or F) : ' read *, ef print *, ' Specify length of numbers (1-99): ' read *, n1 print *, ' Specify number of digits (0-98) : ' read *, k1 if (k1.ge.n1) & print *, ' The second number must be at least smaller' if (n1.le.k1+1) & print *, ' than the first number! Please, repeat it.' if (n1.le.k1+1) & print *, ' ' if (n1.le.k1+1) goto 43 mm = 0 aa(1) = '(' aa(2) = ef call choice1 (3, n1, m1) mm = mm + m1 aa(4+mm) = '.' call choice1 (5+mm, k1, m2) mm = mm + m2 aa(6+mm) = ',' c--- check input write (*, 41) (aa(i), i = 2, 5+mm) 41 format(' You have just selected the format: ', 25a1) c 44 continue c print *, ' Is this format all right? (Y or N) ' c read *, yn c if (yn.ne.'y'.and.yn.ne.'n') c & print *, ' Please, reply Y or N! ' c if (yn.ne.'y'.and.yn.ne.'n'.and.yn.ne.'Y'.and.yn.ne.'N') c & goto 44 c if (yn.eq.'y'.or.yn.eq.'Y') goto 49 c if (yn.eq.'n'.or.yn.eq.'N') goto 43 c 49 continue c--- second number: real part of refr.index or diel.func's 53 continue print *, ' ' print *, ' 2. column: real part of refr.index/...' print *, ' Specify format type (E or F) : ' read *, ef print *, ' Specify length of numbers (1-99): ' read *, n1 print *, ' Specify number of digits (0-98) : ' read *, k1 if (k1.ge.n1) & print *, ' The second number must be at least smaller' if (n1.le.k1+1) & print *, ' than the first number! Please, repeat it.' if (n1.le.k1+1) & print *, ' ' if (n1.le.k1+1) goto 53 mm0 = mm aa(7+mm) = ef call choice1 (8+mm, n1, m1) mm = mm + m1 aa(9+mm) = '.' call choice1 (10+mm, k1, m2) mm = mm + m2 aa(11+mm) = ',' c--- check input write (*, 41) (aa(i), i = 7+mm0, 10+mm) c 54 continue c print *, ' Is this format all right? (Y or N) ' c read *, yn c if (yn.ne.'y'.and.yn.ne.'n') c & print *, ' Please, reply Y or N! ' c if (yn.ne.'y'.and.yn.ne.'n'.and.yn.ne.'Y'.and.yn.ne.'N') c & goto 44 c if (yn.eq.'y'.or.yn.eq.'Y') goto 59 c if (yn.eq.'n'.or.yn.eq.'N') goto 53 c 59 continue c--- third number: imaginary part of refr.index or diel.func's 63 continue print *, ' ' print *, ' 3. column: imaginary part of refr.index/...' print *, ' Specify format type (E or F) : ' read *, ef print *, ' Specify length of numbers (1-99): ' read *, n1 print *, ' Specify number of digits (0-98) : ' read *, k1 if (k1.ge.n1) & print *, ' The second number must be at least smaller' if (n1.le.k1+1) & print *, ' than the first number! Please, repeat it.' if (n1.le.k1+1) & print *, ' ' if (n1.le.k1+1) goto 63 mm0 = mm aa(12+mm) = ef call choice1 (13+mm, n1, m1) mm = mm + m1 aa(14+mm) = '.' call choice1 (15+mm, k1, m2) mm = mm + m2 aa(16+mm) = ')' c--- check input write (*, 41) (aa(i), i = 12+mm0, 15+mm) c 64 continue c print *, ' Is this format all right? (Y or N) ' c read *, yn c if (yn.ne.'y'.and.yn.ne.'n') c & print *, ' Please, reply Y or N! ' c if (yn.ne.'y'.and.yn.ne.'n'.and.yn.ne.'Y'.and.yn.ne.'N') c & goto 44 c if (yn.eq.'y'.or.yn.eq.'Y') goto 69 c if (yn.eq.'n'.or.yn.eq.'N') goto 63 c 69 continue c--- read data till end or error 3 continue read (8, 1, end=8, err=8) al, an, ak 1 format (e11.4, 2e14.5) c--- output quantities goto (11,12), mode1 11 y1 = an y2 = ak goto 19 12 y1 = an**2 - ak**2 y2 = 2 * an * ak 19 continue goto (21,22,23), mode2 21 x = al goto 29 22 x = h * c / al / ev goto 29 23 x = 1 / al 29 continue c--- output write (*, aa) x, y1, y2 write (9, aa) x, y1, y2 c write (9, 6) x, y1, y2 c 6 format (1pe11.4, 2(1pe14.5)) goto 3 8 continue c write (9,7) (a(6,j), j = 1, 80) stop end c--- subroutines subroutine choice1 (j, n, m) parameter (ma=25) character*1 a (ma) common /aaa/ a if (n.le.9) call choice (a(j), n) if (n.le.9) m = 0 if (n.le.9) return nn = n / 10 call choice (a(j), nn) call choice (a(j+1), n - nn*10) m = 1 return end c--- subroutine choice (s, n) character*1 s if (n.ge.10) stop 10 i1 = n if (n.eq.0) i1 = 10 goto (1,2,3,4,5,6,7,8,9,100) i1 1 s = '1' goto 91 2 s = '2' goto 91 3 s = '3' goto 91 4 s = '4' goto 91 5 s = '5' goto 91 6 s = '6' goto 91 7 s = '7' goto 91 8 s = '8' goto 91 9 s = '9' goto 91 100 s = '0' goto 91 91 continue return end c=== eof ===