Last Updated: 04-Nov-1999
Disclaimer
MODULE TUTOR1_GLOBAL
USE FLIB !VERSION CONTROL INFORMATION CHARACTER(LEN=*), PARAMETER :: TUTOR1_VERSION='1.00A' CHARACTER(LEN=*), PARAMETER :: TUTOR1_DATE='05-JUN-1999' CHARACTER(LEN=*), PARAMETER :: TUTOR1_PROGNAME='TUTOR1' CHARACTER(LEN=*), PARAMETER :: TUTOR1_AUTHOR='RD Stewart (trebor@purdue.edu)' LOGICAL :: ECHO_AUTHOR = YES !COMPUTER DEPENDENT COMMANDS CHARACTER(LEN=*), PARAMETER :: ClearScreen='cls' !FILE I/O INTEGER(I4K), PARAMETER :: U4S=6 !device identificaion number for screen LOGICAL :: ECHO=YES !Run-time info on by default INTEGER(I4K) :: U4E=U4S !Print run-time info to screen by default !... PLACE GLOBAL PROGRAM VARIABLES HERE ... END MODULE TUTOR1_GLOBALPROGRAM TUTOR1
! TUTOR1 is (1) a tutorial on the use of several FLIB routines ! and (2) a template for a batch-style user code that reads ! a set of input parameters from one ASCII file, performs a ! calculation and then saves the calculation results to another ! ASCII file. ! ! TIPS AND TRICKS: ! Create a copy of the tutor1.f90 file. For example, create a ! file called myprog.f90. Open myprog.f90 in a text editor with ! search and replace capabilities (almost all do). Use the ! search and replace function of the editor to replace all ! occurrences of the string 'TUTOR1' with 'MYPROG' Viola! You ! are ready to begin adding task specific usercode. ! ! AUTHOR: ! Rob Stewart, Ph.D. ! Pacific Northwest National Laboratory (PNNL) ! PO Box 999, MSIN K3-55 ! Richland, WA 99352-0999 USA ! (509) 375-6851 Voice ! (509) 375-6936 Fax ! trebor@purdue.edu ! http://rh.healthsciences.purdue.edu/faculty/rds.html ! USE TUTOR1_GLOBAL INTEGER(I4K) u4i,u4o,iflg REAL(R8K) T1,T2,TIM !PROGRAM INITIALIZATION CALL CAL_SYSTEM(ClearScreen, iflg) !Clear screen CALL TP_ETIME(t1) !Start program timer !OPEN INPUT FILE AND GENERATE OUTPUT FILE CALL TUTOR1_START('out', u4i,u4o,iflg) IF (iflg < 0) THEN WRITE(unit=U4E,fmt='(1X,A,I3)',iostat=iflg) 'FATAL ERROR: ',iflg WRITE(unit=U4E,fmt='(1X,A)',iostat=iflg) 'BAD TROUBLE IN TUTOR1_start' STOP ELSEIF (iflg > 0) THEN !USER REQUESTED HELP STOP ELSE !CONTINUE WITH PROGRAM EXECUTION CALL TUTOR1_PRNVCI(u4o, iflg) CALL TUTOR1_EchoInput(u4i,u4o, iflg) IF (iflg.NE.0) THEN WRITE(unit=U4E,fmt='(1X,A,I3)',iostat=iflg) 'FATAL ERROR: ',iflg WRITE(unit=U4E,fmt='(1X,A)',iostat=iflg) 'BAD TROUBLE IN TUTOR1_EchoInput' STOP ENDIF ENDIF IF (echo) THEN WRITE(unit=u4e,fmt='(/,1X,A,1PG15.7)',iostat=iflg) & 'PROCESSING INPUT FILE... ' ENDIF ! ... INSERT CODE TO READ PARAMETERS FROM INPUT FILE HERE ... ! Several FIOPAK routines such as VI_GETVAR and VI_DATA ! can greatly simplify the task of reading data from an ! a keyword-based ASCII input file. CLOSE(unit=u4i,status='KEEP') !CLOSE INPUT FILE IF (echo) THEN WRITE(unit=u4e,fmt='(1X,A,1PG15.7)',iostat=iflg) & 'PERFORMING '//TUTOR1_PROGNAME//' CALCULATION... ' ENDIF ! ... INSERT CODE TO PERFORM TASK/CALCULATION HERE ... IF (echo) THEN WRITE(unit=u4e,fmt='(1X,A,1PG15.7,/)',iostat=iflg) & 'SAVING '//TUTOR1_PROGNAME//' RESULTS... ' ENDIF ! ... INSERT CODE TO SAVE RESULTS OF CALCULATION HERE ... !FINAL STEP(s) CALL TP_ETIME(t2) TIM=(t2-t1)/60.0D+00 WRITE(unit=u4o,fmt='(/,A,1PG12.5)',iostat=iflg) & 'Total '// TUTOR1_PROGNAME // ' execution time (min): ',tim IF (echo) THEN WRITE(unit=u4e,fmt='(/,A,1PG12.5)',iostat=iflg) & 'Total '// TUTOR1_PROGNAME // ' execution time (min): ',tim CALL TUTOR1_PRNVCI(u4e, iflg) ENDIF CALL TUTOR1_PRNVCI(u4o, iflg) CLOSE(unit=u4o,status='KEEP') !Close output file IF (u4e.NE.u4s) THEN CLOSE(unit=u4e,status='KEEP') !Close tmp-file ENDIF END !OF TUTOR1SUBROUTINE TUTOR1_START(ext, u4i,u4o,iflg)
! Open input/output files and process command line options. ! ! INPUT: ! ext: name of extension for output filename [A*] ! ! OUTPUT: ! U4I: device identification number for input file [I4] ! U4O: device identification number for output file [I4] ! IFLG: error control flag [I4] ! 1: User requested program help ! 0: no problemo ! -1: cannot open input file ! -2: tmp file is locked or already open ! -3: cannot open tmp file. ! -4: output file is locked or already open ! -5: cannot open output file. ! ! AUTHOR: Robert D. Stewart ! Pacific Northwest National Laboratory (PNNL) ! PO Box 999, MSIN K3-55 ! Richland, WA 99352-0999 USA ! trebor@purdue.edu ! http://rh.healthsciences.purdue.edu/faculty/rds.html ! ! CREATION DATE: 04-JUN-1999 ! REVISIONS HISTORY: ! ! COMMENTS: ! ! USE TUTOR1_GLOBAL CHARACTER(LEN=*) ext INTEGER(I4K) U4I,U4O,IFLG INTEGER(I4K) NARG,JFLG,ILEN CHARACTER(LEN=350) FNI !Input filename CHARACTER(LEN=350) FNO !Output filename CHARACTER(LEN=350) FNT !tmp filename CHARACTER(LEN=80) CLO !Command line options LOGICAL FileOpen INTENT(in) :: ext INTENT(out) :: u4i,u4o,iflg !INITIALIZE VARIABLES CLO=' ' FNI=' ' FNO=' ' FNT=' ' CALL CAL_NARG(narg) IF (narg > 0) THEN !Process command line options CALL CAL_GETARG(1, fni) !Get input filename !Check for user requested program help CALL STR_ADD(fni,clo) CALL TRANUC(clo) CALL STRIP(clo) IF ((clo(:2).EQ.'-H').OR.(clo(:2).EQ.'/H')) THEN CALL TUTOR1_HELP(6, iflg) IFLG=1 RETURN ENDIF !open input file CALL CHANNEL(u4i) OPEN(unit=u4i,file=fni,iostat=jflg,status='OLD') IF (jflg.NE.0) THEN !BAD INPUT FILE WRITE(unit=u4s,fmt='(1X,A)',iostat=jflg) 'FNI: '//fni(:MAX(1,LENTRIM(fni))) CLOSE(unit=u4i,iostat=jflg) iflg=-1 u4i=0 RETURN ENDIF !Look for additional command line options IF (narg > 1) THEN CALL CAL_GETARG(2, CLO) CALL STRIP(clo) CALL TRANUC(clo) IF ((clo(:2).EQ.'-S').OR.(clo(:2).EQ.'/S')) THEN !SILENT PROGRAM EXECUTION ECHO=NO U4E=0 ELSEIF ((clo(:2).EQ.'-U').OR.(clo(:2).EQ.'/U')) THEN !PRINT RUN-TIME INFO TO SCREEN OR TMP-FILE ECHO=YES IF (clo(3:3).EQ.'6') THEN U4E=U4S !Print to screen ELSE !GENERATE TMP FILE CALL FN_SAVE(fni,jflg) !Save input filename and path CALL FN_SETFNX('tmp') !Change output file extension CALL FN_GETCFN(0, fnt) !Retrieve output filename INQUIRE(file=fnt,OPENED=FileOpen) IF (FileOpen) THEN WRITE(unit=u4s,fmt='(1X,A)',iostat=jflg) 'FNT: '//fnt(:MAX(1,LENTRIM(fnt))) IFLG=-2 RETURN ENDIF CALL CHANNEL(U4E) OPEN(unit=u4e,file=fnt,iostat=jflg) IF (jflg.NE.0) THEN IFLG=-3 WRITE(unit=u4s,fmt='(1X,A)',iostat=jflg) 'FNT: '//fnt(:MAX(1,LENTRIM(fnt))) RETURN ENDIF ENDIF ENDIF ENDIF !End of command line option processing IF (echo) THEN CALL TUTOR1_PRNVCI(u4e,jflg) ENDIF ELSE !PROMPT USER FOR INPUT FILENAME AND OPTIONS CALL TUTOR1_MENU(fni,jflg) !PROCESS POSSIBLE REQUEST FOR PROGRAM HELP CALL STR_ADD(fni,clo) CALL TRANUC(clo) CALL STRIP(clo) IF ((clo(:2).EQ.'-H').OR.(clo(:2).EQ.'/H')) THEN CALL CAL_SYSTEM(ClearScreen, iflg) CALL TUTOR1_HELP(6, iflg) IFLG=1 RETURN ENDIF !open input file CALL CHANNEL(u4i) ilen=MAX(1,LENTRIM(fni)) OPEN(unit=u4i,file=fni(:ilen),iostat=jflg,status='OLD') IF (jflg.NE.0) THEN !BAD INPUT FILE WRITE(unit=u4s,fmt='(1X,A)',iostat=jflg) 'FNI: '//fni(:MAX(1,LENTRIM(fni))) CLOSE(unit=u4i,iostat=jflg) iflg=-1 u4i=0 RETURN ENDIF ENDIF !LAST STEP: Generate Output File CALL FN_SAVE(fni,jflg) !Save input filename and path CALL FN_SETFNX(ext) !Change output file extension CALL FN_GETCFN(0, fno) !Retrieve output filename INQUIRE(file=fno,OPENED=FileOpen) IF (FileOpen) THEN WRITE(unit=u4s,fmt='(1X,A)',iostat=jflg) 'FNO: '//fno(:MAX(1,LENTRIM(fno))) iflg=-4 RETURN ELSE !OPEN OUTPUT FILE CALL CHANNEL(u4o) OPEN(unit=u4o,file=fno,iostat=jflg) IF (jflg.NE.0) THEN !Cannot create output file WRITE(unit=u4s,fmt='(1X,A)',iostat=jflg) 'FNO: '//fno(:MAX(1,LENTRIM(fno))) iflg=-5 RETURN ENDIF ENDIF !READY FOR ACTION IFLG=0 IF (echo) THEN WRITE(unit=u4e,fmt='(1X,A)',iostat=jflg) 'FNI: '//fni(:MAX(1,LENTRIM(fni))) IF (u4e.NE.u4s) WRITE(unit=u4e,fmt='(1X,A)',iostat=jflg) 'FNT: '//fnt(:MAX(1,LENTRIM(fnt))) WRITE(unit=u4e,fmt='(1X,A)',iostat=jflg) 'FNO: '//fno(:MAX(1,LENTRIM(fno))) ENDIF RETURN ENDSUBROUTINE TUTOR1_MENU(fni,iflg)
! Prompt user for with an interactive menu. ! ! INPUT: ! N/A ! ! OUTPUT: ! FNI: Name of an input file [A*] ! IFLG: task completion flag [I4] ! 0: task successful ! -1: task failed: invalid file/device handle ! -2: task failed while print to unit=io. ! ! AUTHOR: Rob Stewart, Ph.D. ! Pacific Northwest National Laboratory (PNNL) ! PO Box 999, MSIN K3-55 ! Richland, WA 99352-0999 USA ! (509) 375-6851 Voice ! (509) 375-6936 Fax ! trebor@purdue.edu ! http://rh.healthsciences.purdue.edu/faculty/rds.html ! ! CREATION DATE: 04-JUN-1999 ! REVISIONS HISTORY: ! ! COMMENTS: ! USE TUTOR1_GLOBAL CHARACTER(LEN=*) FNI INTEGER(I4K) iflg INTENT(out) :: fni,iflg FNI=' ' CALL TUTOR1_PRNVCI(u4s, iflg) WRITE(unit=u4s,fmt='(/,A)',ADVANCE='NO',iostat=iflg) 'Enter name of ' & // TUTOR1_PROGNAME // ' input file (-h for help): ' READ(*,'(A)') FNI !read from default input device RETURN ENDSUBROUTINE TUTOR1_EchoInput(u4i,u4o, iflg)
! Echo input data from the ASCII file open on unit=u4i to ! the output file open on unit=u4o. ! ! INPUT: ! u4i: device handle for input file [I4] ! u4o: device handle for output file [I4] ! ! OUTPUT: ! IFLG: task completion flag [I4] ! 0: no problemo ! -1: bad input device number ! -2: bad output device number ! -3: bad trouble while writing to output file ! -4: bad trouble in FIO_ECHO ! ! AUTHOR: Rob Stewart, Ph.D. ! Pacific Northwest National Laboratory (PNNL) ! PO Box 999, MSIN K3-55 ! Richland, WA 99352-0999 USA ! (509) 375-6851 Voice ! (509) 375-6936 Fax ! trebor@purdue.edu ! http://rh.healthsciences.purdue.edu/faculty/rds.html ! ! CREATION DATE: 04-JUN-1999 ! REVISIONS HISTORY: ! ! COMMENTS: ! USE TUTOR1_GLOBAL INTEGER(I4K) U4I,U4O,IFLG,JFLG LOGICAL ok INTENT(IN) :: U4I,U4O INTENT(OUT) :: IFLG INQUIRE(unit=u4i, OPENED = ok) IF (.not.ok) THEN !Bad input device number IFLG=-1 RETURN ENDIF INQUIRE(unit=u4o, OPENED = ok) IF (.not.ok) THEN !Bad output device number IFLG=-2 RETURN ENDIF !Echo Input Data to Output File WRITE(unit=u4o,fmt='(/,1X,A)',iostat=jflg) & '---------- INPUT DATA' IF (jflg.NE.0) THEN IFLG=-3 RETURN ENDIF CALL FIO_ECHO(u4i,u4o,'0100', jflg) !Echo input file to output file. IF (jflg.NE.0) THEN IFLG=-4 RETURN ENDIF WRITE(unit=u4o,fmt='(1X,A,/)',iostat=jflg) & '---------- END OF INPUT DATA' IF ((u4e.NE.u4s).AND.(echo)) THEN !ECHO INPUT FILE TO TMP-FILE WRITE(unit=u4e,fmt='(/,1X,A)',iostat=jflg) & '---------- INPUT DATA' CALL FIO_ECHO(u4i,u4e,'0100', jflg) !Echo input file to tmp file. WRITE(unit=u4e,fmt='(1X,A,/)',iostat=jflg) & '---------- END OF INPUT DATA' ENDIF IFLG=0 RETURN ENDSUBROUTINE TUTOR1_PRNVCI(io, iflg)
! Print version control information to unit=io. ! ! INPUT: ! io: a valid file or device handle [I4] ! ! OUTPUT: ! IFLG: task completion flag [I4] ! 0: task successful ! -1: task failed: invalid file/device handle ! -2: task failed while print to unit=io. ! ! AUTHOR: Rob Stewart, Ph.D. ! Pacific Northwest National Laboratory (PNNL) ! PO Box 999, MSIN K3-55 ! Richland, WA 99352-0999 USA ! (509) 375-6851 Voice ! (509) 375-6936 Fax ! trebor@purdue.edu ! http://rh.healthsciences.purdue.edu/faculty/rds.html ! ! CREATION DATE: 04-JUN-1999 ! REVISIONS HISTORY: ! ! COMMENTS: ! USE TUTOR1_GLOBAL INTEGER(I4K) IO,IFLG,JFLG,ILEN LOGICAL ok CHARACTER(LEN=80) STAMP INTENT(IN) :: IO INTENT(OUT) :: IFLG IF (io.NE.u4s) THEN INQUIRE(unit=io, OPENED = ok) IF (.not.ok) THEN !Invalid device handle IFLG=-1 RETURN ENDIF ENDIF !PROGRAM VERSION + DATE/TIME STAMP CALL TP_SetSys STAMP=' ' CALL SP_CATSTR(TUTOR1_PROGNAME,'',stamp) CALL SP_CATSTR(TUTOR1_VERSION,' ',stamp) CALL SP_CATSTR(TUTOR1_DATE,' ',stamp) ILEN=MAX(LENTRIM(stamp)+2,57) CALL TP_AddDat(stamp(ILEN:)) ILEN=LENTRIM(stamp)+2 CALL TP_AddTim(stamp(ilen:)) WRITE(unit=io,fmt='(A)',ADVANCE='NO',iostat=jflg) STAMP IF (jflg.NE.0) THEN IFLG=-1 RETURN ENDIF IF (ECHO_AUTHOR) THEN WRITE(unit=io,iostat=jflg,fmt='(A,/)') 'by '// TUTOR1_AUTHOR ECHO_AUTHOR=NO !Just print program author 1st time ENDIF RETURN ENDSUBROUTINE TUTOR1_HELP(io, iflg)
! Print help on program usage to unit=io. ! ! INPUT: ! io: a valid file or device handle [I4] ! ! OUTPUT: ! IFLG: task completion flag [I4] ! 0: task successful ! -1: task failed: invalid file/device handle ! -2: task failed while print to unit=io. ! ! AUTHOR: Rob Stewart, Ph.D. ! Pacific Northwest National Laboratory (PNNL) ! PO Box 999, MSIN K3-55 ! Richland, WA 99352-0999 USA ! (509) 375-6851 Voice ! (509) 375-6936 Fax ! trebor@purdue.edu ! http://rh.healthsciences.purdue.edu/faculty/rds.html ! ! CREATION DATE: 04-JUN-1999 ! REVISIONS HISTORY: ! ! COMMENTS: ! USE TUTOR1_GLOBAL INTEGER(I4K) IO,IFLG,JFLG LOGICAL ok INTENT(IN) :: IO INTENT(OUT) :: IFLG IF (io.NE.u4s) THEN INQUIRE(unit=io, OPENED = ok) IF (.not.ok) THEN !Invalid device handle IFLG=-1 RETURN ENDIF ENDIF !PROGRAM VERSION + DATE/TIME STAMP CALL TUTOR1_PRNVCI(io, jflg) !PRINT VERSION INFO TO UNIT=IO WRITE(io,'(/,A)') 'PROGRAM USAGE: ' WRITE(io,'(2X,A)') TUTOR1_PROGNAME // ' <input filename> -<command line option>' WRITE(io,'(/,A)') 'OPTIONS: ' WRITE(io,'(2X,A)') ' S: silent program execution' WRITE(io,'(2X,A)') 'U6: echo program run-time information to screen' WRITE(io,'(2X,A)') ' U: echo program run-time information to tmp file' WRITE(io,'(2X,A)') ' H: program help' WRITE(io,'(/,A)') 'EXAMPLES: ' WRITE(io,'(2X,A)') TUTOR1_PROGNAME // ' (interactive execution)' WRITE(io,'(2X,A)') TUTOR1_PROGNAME // ' myprog.inp -S (silent execution)' WRITE(io,'(2X,A)') TUTOR1_PROGNAME // ' myprog.inp -U6 (run-time info to screen)' WRITE(io,'(2X,A)') TUTOR1_PROGNAME // ' myprog.inp -U (run-time info to tmp-file)' WRITE(io,'(2X,A)') TUTOR1_PROGNAME // ' myprog.inp (run with default options)' WRITE(io,'(2X,A)') TUTOR1_PROGNAME // ' -H (program help)' RETURN END
|
Website maintained by Rob Stewart
(trebor@purdue.edu). Last Updated: 04-Nov-1999 Disclaimer | |