{"id":201,"date":"2017-09-13T11:11:44","date_gmt":"2017-09-13T14:11:44","guid":{"rendered":"http:\/\/www.professores.uff.br\/diomarcesarlobao\/?page_id=201"},"modified":"2017-09-13T11:11:44","modified_gmt":"2017-09-13T14:11:44","slug":"charvar-f","status":"publish","type":"page","link":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/charvar-f\/","title":{"rendered":"charvar.f"},"content":{"rendered":"
c<html>\r\nc<head><title>charvar.f<\/title><\/head>\r\nc<body>\r\nc<pre>\r\n      \r\n\tProgram charvar\r\nc\r\nc    Demonstrate use of character variables\r\nc    Everything in this program is Fortran 77, and all of the\r\nc    essentials are demonstrated at least once.\r\nc\r\nc    John Mahaffy, 2\/7\/96\r\nc\r\n      implicit none\r\n      integer nwords,nwin\r\n      parameter (nwords=10)\r\n      character*80 line\r\n      character keyword(nwords)*16, tform*8\r\n      real value(nwords)\r\nc\r\nc     line   -  character string to contain one line of input\r\nc     keyword -  a character array containing keywords to determine\r\nc                variable assignments\r\nc     value   -  a character array containing values associated with\r\nc                keywords\r\nc     nwords  -  maximum number of entries in arrays \"keyword\" and \"value\"\r\nc     nwin    -  actual number of entries in arrays \"keyword\" and \"value\"\r\nc     tform   -  character string to contain the format for Temperatures\r\nc\r\nc    Get some information from a file  (first executable statement)\r\nc\r\n      call input (nwords,line,keyword,value,nwin,tform)\r\nc\r\nc     Process  the contents of \"line\"\r\nc\r\n      call doline(line)\r\nc\r\nc     I could use this routine to work on any character\r\nc     string\r\nc\r\n      call doline ('This string can be parsed')\r\nc\r\nc     Process the kewords and associated values\r\nc\r\n      call props ( keyword, value, nwin, tform)\r\nc\r\n      stop\r\n      end\r\nc\r\nc\r\nc\r\n      subroutine input(nwords,line,keyword,value,nwin,tform)\r\nc\r\nc     Open an input file and read some information\r\nc\r\nc     John Mahaffy  3\/8\/95\r\nc\r\n      implicit none\r\n      integer nwords,nwin, nstring, nget, inerr, ioerr, ierr\r\n      parameter (nget=2)\r\n      integer istring(nget), ndigits, ispace, nline\r\n      character string(nget)*16 , tform*(*)\r\nc\r\nc   The subroutine doesn't need to be told the length of the character\r\nc   variables, the information is passed without your knowing it.  This\r\nc   gives your subroutine the power to work on character strings with\r\nc   many different lengths.\r\nc\r\n      character*(*) line\r\n      character keyword(nwords)*(*)\r\n      real value(nwords)\r\nc\r\n      character fname*16, answer*8, inline*80\r\n      logical fexist\r\nc\r\nc   Arguments\r\nc\r\nc   Input -\r\nc   nwords - size of the keyword and value character arrays\r\nc\r\nc   Output -\r\nc     line   -  character string to contain one line of input\r\nc     keyword -  a character array containing keywords to determine\r\nc                variable assignments\r\nc     value   -  a character array containing values associated with\r\nc                keywords\r\nc     nwin    -  actual number of entries in arrays \"keyword\" and \"value\"\r\nc     tform   -  character string to contain the format for Temperatures\r\nc\r\nc   Other important variables\r\nc     number  -   character representation of the value associated with\r\nc                 the keyword\r\nc     fname  -    name of file containing input\r\nc     inline -    contains an input line with a keyword, value pair\r\nc     string -    array  containing contiguous character strings from inline\r\nc     istring-    array giving starting location of corresponding element in\r\nc                 string within inline\r\nc     nget   -    number of strings to get from inline\r\nc     nstring-    number of strings actually found in inline\r\nc     inerr  -    keep track of fatal input errors\r\nc     ioerr  -    flag error on real numbers\r\nc     nline  -    current line number within the input file\r\nc\r\nc   Begin executable code by opening the I\/O   units\r\nc\r\n   5  write(*,1000)\r\n 1000 format ( 'Provide name of the input file:')\r\n      read *, fname\r\n      write(*,*)\r\nc <a name=\"inquire\"><font color=\"FF0000\">\r\n      inquire (file=fname,exist=fexist)\r\nc <\/font><\/a>\r\n      if (.not.fexist) then\r\n         write(*, *)  fname,' does not exist'\r\n         write(*, *) 'Do you want to quit (yes or no)?'\r\n         read (*,1001) answer\r\n         if (answer(1:1).eq.'y'.or.answer(1:1).eq.'Y') stop\r\n         go to 5\r\n      endif\r\n      open (11,file=fname,status='old',err=600)\r\n      read(11,1001,end=602) line\r\n      inerr= 0\r\n      nline=1\r\n      do 30 nwin=1,nwords\r\nc\r\nc          The 1001 in the next line is necessary. Try a '*' and see what\r\nc          happens.\r\nc\r\n   10    read (11,1001,end=40) inline\r\n         nline=nline+1\r\n         call parsl (inline,string,nget,nstring,istring,ierr)\r\nc\r\nc          Detect fatal errors, but don't quit yet\r\nc\r\n         if (ierr.ne.0) then\r\n            write(*, *) 'Problem is in line ',nline\r\n            write(*, *)\r\n            inerr=inerr+1\r\n         endif\r\n         if ( nstring.lt. nget) then\r\n            if (nstring.le.0) go to 10\r\n            write(*, *) 'Insufficient information in line ',nline\r\n     $               , ' :'\r\n            write(*, *) inline\r\n            write(*, *)\r\n            inerr=inerr+1\r\n         endif\r\nc\r\nc\r\nc          When numerous case combinations are possible and\r\nc          relational tests will be used, it is a good idea\r\nc          to internally convert keyword strings to a single\r\nc          case\r\nc\r\n         call upper (string(1))\r\n         keyword(nwin)=string(1)\r\nc\r\nc          Put the input value (character string) into a real\r\nc          variable\r\nc <a name=\"read\"><font color=\"FF0000\">\r\n         read(string(2),'(e16.5)',iostat=ioerr) value(nwin)\r\nc <\/font><\/a>\r\n         if (ioerr.ne.0) then\r\n            inerr=inerr+1\r\n            ispace= index(string(2),' ') - 1\r\n            write(*, *) 'Error interpreting : ',string(2)(1:ispace),\r\n     $               ' as a real number in line ', nline\r\n            write(*, *)\r\n         endif\r\n   30 continue\r\nc\r\nc        Check if remaining lines are blank or comments\r\nc\r\n   35 read (11,1001,end=40) inline\r\n      if(inline.eq.' ') go to 35\r\n      ispace = index(inline ,'!')\r\n      if (ispace.ne.0) then\r\n         if( inline(1:(ispace-1)).eq.' ') go to 35\r\n      endif\r\n      write(*, *) 'More than ',nwords, 'keywords.  Rest ignored'\r\n      write(*,*) 'Recompile with a larger value for the parameter',\r\n     &            ' nwords'\r\nc\r\nc      Done reading the file.  Wrap up and deal with errors\r\nc\r\n   40 nwin=nwin-1\r\n      if (nwin.le.0) then\r\n         write(*,*) 'No Keyword information in the input deck'\r\n         inerr=inerr+1\r\n         endif\r\n      if(inerr.gt.0) then\r\n         write(*, *) inerr,' Fatal Input Errors on Unit 11, Quiting Now'\r\n         stop\r\n      endif\r\n      write(*,2000)\r\n      read(*,'(i5)') ndigits\r\n      write(*,*)\r\nc<a name=1><font color=FF0000>\r\n      ndigits=min(9,max(0,ndigits))\r\nc<\/font>\r\n      ispace=ndigits+6\r\n      write(tform,1002) ispace,ndigits\r\n      return\r\nc\r\n  600 write(*, *)'Problem opening file: ', fname\r\n      stop\r\n  602 write(*, *) ' No Data in the Input File'\r\n      stop\r\n 1001 format (a)\r\n 1002 format ('f',i2,'.',i1)\r\n 2000 format (' Number of digits you want printed after the',\r\n     $ ' decimal for Temperatures: ')\r\n      end             \r\nc\r\nc\r\nc\r\n      subroutine upper(string)\r\nc\r\nc     Convert lower case to upper case.\r\nc     This is one good use of ichar and char intrinsic functions\r\nc\r\nc     John Mahaffy  3\/8\/96\r\nc\r\n      character string*(*)\r\nc<a name=3><font color=FF0000>\r\n      lc=len(string)\r\nc<\/font>\r\n      icdiff=ichar('A')-ichar('a')\r\n      do 10 i=1,lc\r\n      if(string(i:i).lt.'a'.or.string(i:i).gt.'z') go to 10\r\nc\r\nc   shift lower case to upper case\r\nc\r\n      string(i:i)=char(ichar(string(i:i))+icdiff)\r\n   10 continue\r\n      return\r\n      end\r\nc\r\nc\r\nc\r\n      subroutine doline(line)\r\nc\r\nc    processrate use of character variables\r\nc    Everything in this program is Fortran 77\r\nc\r\nc    John Mahaffy 3\/8\/96\r\nc\r\n      implicit none\r\n      integer nwords, nwmax, i, ihigh, ilow, ierr, lline, loline\r\n      parameter (nwmax=5)\r\n      character*(*) line\r\n      character*80 oline\r\n      character words(nwmax)*16 , form1*16\r\n      integer lwords(nwmax)\r\nc\r\nc     INPUT\r\nc     line   -   A line containing characters\r\nc     OTHER IMPORTANT Variables\r\nc\r\nc      words -    array  containing contiguous character strings from line\r\nc     lwords -   array giving starting location of corresponding element in\r\nc                 words within line, later used to contain word length\r\nc     nwmax  -    maximum number of strings to get from line\r\nc     nstring-    number of strings actually found in line\r\nc\r\nc    Begin Executable Code\r\nc\r\n      lline=len(line)\r\n      call parsl (line,words,nwmax,nwords,lwords,ierr)\r\n      if (ierr.ne.0) then\r\n         write(*, *) 'Word length exceeded in line 1'\r\n      endif\r\n      write(*, *)\r\n      write(*, *) 'Original First Line'\r\n      write(*, *) line\r\nc\r\nc     Note that you can't reassemble the line neatly by printing the\r\nc     words directly\r\nc\r\n      loline=len(oline)\r\n      oline=words(1)\/\/words(2)\/\/words(3)\/\/words(4)\/\/words(5)\r\n      write(*, *) 'Direct combination of Parsed Words from the Line'\r\n      write(*,2000) oline\r\nc\r\nc     However, you have enough information to do a good job of\r\nc     reassembly\r\nc\r\n      ihigh=0\r\n      oline=' '\r\n      do 20 i=1,nwords\r\n         lwords(i)=  index( words(i), ' ') - 1\r\n         if(lwords(i).lt.0) lwords(i)=16\r\nc<a name=2><font color=FF0000>\r\n         ilow=min(ihigh+1,loline)\r\n         ihigh=min(ihigh+lwords(i)+1 ,loline)\r\nc<\/font>\r\n  20     oline(ilow:ihigh)=words(i)(1:lwords(i))\/\/' '\r\n      write(*, *)\r\n      write(*, *) '  Reconstructed line'\r\n      write(*,2000) oline\r\n      write(form1,2001) nwmax\r\nc\r\nc    You can also reconstruct the line with a write statement\r\nc\r\n      write(*,form1) (words(i)(1:lwords(i)),i=1,nwords)\r\n      return\r\n 2000 format (a)\r\n 2001 format ('(',i3,'(a,'' ''))')\r\n      end\r\nc\r\nc\r\nc\r\n      subroutine parsl (line,sym,nfnd,nsym,isym,ierr)\r\nc\r\nc    Separate the individual words in the line for\r\nc    later interpretation.  This action is commonly\r\nc    called \"parsing\".\r\nc\r\nc    John Mahaffy 3\/8\/95\r\nc\r\nc    This is a good example of how not to program.  Notice how the\r\nc    tangle of GO TO Statements make interpretation of the subroutine\r\nc    nearly impossible.  It is also an example of the advantages of\r\nc    subroutines.  I wrote the core of this subroutine shortly after\r\nc    the advent of Fortran 77, applying old Fortran 66 habits. Whenever\r\nc    I've needed to parse a line since then, I've dug this out and\r\nc    plugged it into my program with little or no modifications.\r\nc\r\nc    INPUT\r\nc     line   -   line to be parsed\r\nc     sym    -   array containing individual words in the line\r\nc     nfnd   -   number of words desired from the line\r\nc     OUTPUT\r\nc     nsym   -   number of words found in the line\r\nc     isym   -   array containing the starting location of each word\r\nc     ierr   -   error flag set if any words are too long\r\nc     OTHER important variables\r\nc     lline  -   actual size of line as set in the calling routine\r\nc     lsym   -   actual number of characters allowed for each word\r\nc\r\n      dimension isym(*)\r\n      character line*(*),sym(*)*(*)\r\n      lsym=len(sym(1))\r\n      lline=len(line)\r\n      nsym=0\r\n      ierr=0\r\n      do 10 i=1,nfnd\r\n   10 sym(i)=' '\r\n      i=1\r\n      j=1\r\nc\r\nc    Space, equals, and comma are considered word separators here\r\nc    An exclamation point ends processing of the line (rest ignored)\r\nc\r\n 20   if(i.gt.lline) go to 80\r\n      if(line(i:i).eq.' '.or.line(i:i).eq.'='.or.\r\n     &   line(i:i).eq.',' ) go to 24\r\n      if(line(i:i).eq.'!')  go to 80\r\n      go to 30\r\n 24   i=i+1\r\n      j=1\r\n      new=1\r\n      go to 20\r\n   30 if (1.lt.j) go to 40\r\n      if(sym(nsym).eq.'!') go to 80\r\n      nsym=nsym+1\r\n      isym(nsym)=i\r\n      if(nsym.gt.nfnd) go to 80\r\n   40 if (lsym.lt.j) go to 55\r\n      sym(nsym)(j:j)=line(i:i)\r\n      i=i+1\r\n      j=j+1\r\n      go to 20\r\n 55   ierr=1\r\n      write(*,2002) lsym\r\n 2002 format(' This word has more than',i3,' characters')\r\n      call poinat(line,9,i)\r\n      il=i+1\r\n      do 60 i=il,lline\r\n      if(line(i:i).eq.' '.or.line(i:i).eq.'='.or.\r\n     $   line(i:i).eq.',') go to 24\r\n   60 continue\r\n 80   return\r\nc\r\n      end\r\nc\r\nc\r\nc\r\n      subroutine poinat(line,nw,ic)\r\nc\r\nc   Write line and a pointer under character ic.\r\nc\r\n      character line*80\r\n      character f*40\r\n      icm=ic-1\r\n      write(f,2000) icm\r\n 2000 format('(',i3,'x,''^'')')\r\n      write(*,2020)line\r\n 2020 format(\/(1x,a80))\r\n      write(*,f)\r\n      return\r\n      end\r\nc\r\nc\r\nc\r\n      subroutine props ( keyword, value, nwin, tform)\r\nc\r\nc    Do something with all of the keywords.  The basic\r\nc    fuctionality of this keyword based input is captured\r\nc    in the Fortran NAMELIST structure.  However, NAMELIST\r\nc    was a nonstandard extension of Fortran 77 (now standard\r\nc    in Fortran 90), and NAMELIST has less flexiblity in\r\nc    error processing.\r\nc\r\n      implicit none\r\n      integer nwin, i\r\n      character keyword(nwin)*(*),tform*8, form1*40\r\n      real t,p,rho,rg, value(nwin)\r\n      parameter (rg=287.0478)\r\n      data t,p,rho\/3*0.0\/\r\nc\r\nc     keyword -  a character array containing keywords to determine\r\nc                variable assignments\r\nc     value   -  a character array containing values associated with\r\nc                keywords\r\nc     nwin    -  actual number of entries in arrays \"keyword\" and \"value\"\r\nc     tform   -  character string to contain the format for Temperatures\r\nc\r\n      form1 ='( '' Temperature = '','\/\/tform \/\/','' K'')'\r\n      write(*, *)\r\n      do 100  i=1,nwin\r\n         if (keyword(i).eq.'T'.or.keyword(i).eq.'TEMP'.or.keyword(i)\r\n     $       .eq.'TEMPERATURE') then\r\n            t=value(i)\r\n            write(*,form1) t\r\n         else if (keyword(i).eq.'P'.or.keyword(i).eq.'PRES'\r\n     $             .or.keyword(i).eq.'PRESSURE') then\r\n            p=value(i)\r\n            write(*,2001) p\r\n         else\r\n            write(*,2002) i\r\n            write(*,'(a)') keyword(i)\r\n            write(*,*)\r\n         endif\r\n  100 continue\r\nc\r\nc     Normally variables set from this type of processing would be\r\nc     passed back through the argument list, or through a COMMON\r\nc     block.    I'll just do a quick calculation here to at least\r\nc     say that they were put to use.\r\nc\r\n      rho=p\/(rg*t)\r\n      write(*,2003) rho\r\nc\r\n      return\r\n 2001 format ( ' Pressure = ',1p,e10.3,' Pa')\r\n 2002 format (\/, ' I can''t recognize keyword number ',i3)\r\n 2003 format ( ' Density based on last T and P is: ',1p,e10.3,\r\n     $         ' kg\/m**3')\r\n      end\r\nc <\/pre>\r\nc <\/body>\r\nc <\/html>\r\nc<\/pre>\n","protected":false},"excerpt":{"rendered":"
c<html> c<head><title>charvar.f<\/title><\/head> c<body> c<pre> Program charvar c c Demonstrate use of character variables c Everything in this program is Fortran 77, and all of the c essentials are demonstrated at least once. c c John Mahaffy, 2\/7\/96 c implicit none integer nwords,nwin parameter (nwords=10) character*80 line character keyword(nwords)*16, tform*8 real value(nwords) c c line – […]<\/p>\n","protected":false},"author":22,"featured_media":0,"parent":0,"menu_order":0,"comment_status":"closed","ping_status":"closed","template":"","meta":{"_exactmetrics_skip_tracking":false,"_exactmetrics_sitenote_active":false,"_exactmetrics_sitenote_note":"","_exactmetrics_sitenote_category":0,"footnotes":""},"categories":[],"tags":[],"class_list":["post-201","page","type-page","status-publish","hentry"],"_links":{"self":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/201","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages"}],"about":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/types\/page"}],"author":[{"embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/users\/22"}],"replies":[{"embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/comments?post=201"}],"version-history":[{"count":1,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/201\/revisions"}],"predecessor-version":[{"id":202,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/201\/revisions\/202"}],"wp:attachment":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/media?parent=201"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/categories?post=201"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/tags?post=201"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}