{"id":203,"date":"2017-09-13T11:12:24","date_gmt":"2017-09-13T14:12:24","guid":{"rendered":"http:\/\/www.professores.uff.br\/diomarcesarlobao\/?page_id=203"},"modified":"2017-09-13T11:12:24","modified_gmt":"2017-09-13T14:12:24","slug":"charvr90-f","status":"publish","type":"page","link":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/charvr90-f\/","title":{"rendered":"charvr90.f"},"content":{"rendered":"
c<html>\r\nc<head><title>charvar90.f<\/title><\/head>\r\nc<body>\r\nc<pre>\r\n\r\n      Program charvar90\r\nc\r\nc    Demonstrate use of character variables\r\nc    Features of Fortran 90 are applied, but not all of the\r\nc    Fortran 90 intrinsic functions are used.\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, nline\r\n      parameter (nget=2)\r\n      integer istring(nget), ndigits, ispace\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, blank*2\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  -    line number in input file\r\nc\r\nc   Begin executable code by opening the I\/O   units\r\nc\r\n      fexist=.false.\r\n      do while (.not.fexist)\r\n         write(*,1000,advance='no')\r\n 1000    format ( 'Provide name of the input file: ')\r\n         read *, fname\r\n      write(*,*)\r\n         inquire (file=fname,exist=fexist)\r\n         if (fexist) exit\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         call leftjust (answer)\r\n         if (answer(1:1).eq.'y'.or.answer(1:1).eq.'Y') stop\r\n      end do\r\nc <a name=\"open\"><font color=\"FF0000\">\r\n      open (11,file=fname,status='old',err=600)\r\nc <\/font><\/a>\r\n      read(11,1001,end=602) line\r\n      inerr= 0\r\n      nwin=0\r\n      nline=1\r\n      do while (nwin.lt.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\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\nc<a name=\"cycle\"><font color=\"FF0000\">\r\n            if (nstring.le.0) cycle\r\nc<\/font><\/a>\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            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         nwin=nwin+1\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\r\nc          In the past, I've used machines that would require a\r\nc          right justification of string(2) prior to the following\r\nc          read.  Probably not a problem any more.\r\nc   <a name=1><font color=\"FF0000\">\r\nc        string(2)=adjustr(string(2))\r\nc        <\/font>\r\nc          This read takes the character contents of \"string(2)\" and\r\nc          converts them to internal floating point representation in\r\nc          the real variable \"value\"\r\nc\r\n         read(string(2),'(e16.5)',iostat=ioerr) value(nwin)\r\nc\r\n         if (ioerr.ne.0) then\r\n            inerr=inerr+1\r\n            write(*, *) 'Error interpreting : ',trim(string(2)),\r\n     $               ' as a real number in line ', nline\r\n            write(*, *)\r\n         endif\r\n      end do\r\nc\r\nc       Check if remainder of the file is blank or comment lines\r\nc\r\n      blank=' '\/\/achar(9)\r\n      ispace=0\r\n      do while (ispace.eq.0)\r\n         read (11,1001,end=40) inline\r\nc        <a name=2><font color=\"0000FF\">\r\n         ispace=verify(inline,blank)\r\nc         <\/font>\r\n         if (ispace.ne.0.and.inline(ispace:ispace).eq.'!') ispace=0\r\n      end do\r\nc\r\nc       Write a message if the input file is too long\r\nc\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 if (nwin.le.0) then\r\n         write(*,*) 'No Keyword information in the input deck'\r\n         inerr=inerr+1\r\n         endif\r\nc\r\nc       Shut down on certain input errors\r\nc\r\n      if(inerr.gt.0) then\r\n         write(*, *) inerr,' Fatal Errors during input from data file'\r\n         stop\r\n      endif\r\nc\r\nc       Code to let the user determine the output for one variable\r\nc\r\n      write(*,2000, advance='no')\r\n 2000 format (' Number of digits you want printed after the',\r\n     $        ' decimal',' for Temperatures: ')\r\n      read(*,*) ndigits\r\n      write(*,*)\r\n      ndigits=min(9,max(0,ndigits))\r\n      ispace=ndigits+6\r\n      write(tform,1002) ispace,ndigits\r\n      return\r\nc\r\nc       Termination Messages for File problems\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\nc\r\nc       Some people like to put formats a the end of a routine in one\r\nc       organized location.  I tend to group most with the associated\r\nc       I\/O (read, write, print) statements, when they add to the\r\nc       immediate understanding of the code. I put formats with little\r\nc       important information, or that are used by several I\/O statement\r\nc       at the end of the routine\r\nc\r\n 1001 format (a)\r\n 1002 format ('f',i2,'.',i1)\r\n      end             \r\nc\r\nc\r\nc\r\n      subroutine leftjust(string)\r\n      implicit none\r\n      character string*(*), tab*1, ignore*2\r\n      integer lstring,istart\r\nc\r\nc       John Mahaffy    3\/8\/96\r\nc\r\nc\r\nc       Its a good idea not to depend on the beginning of a user\r\nc       response landing in the first character of the string\r\nc       being read.  Infrequently people hit a space before letters.\r\nc       With Unix it is possible to obtain normal keyboard input from\r\nc       a file (e.g. \"a.out < keyin\" takes input from the file \"keyin\")\r\nc       People frequently add spaces or tabs to begin lines in such\r\nc       files to Highlight certain items.\r\nc\r\nc       This subroutine removes leading blanks and tabs.  If only blanks\r\nc       were expected, the contents could be replaced by applying the\r\nc       Fortran 90 character function \"adjustl\"\r\nc\r\nc     string = adjustl(string)\r\nc\r\n      lstring=len(string)\r\nc\r\nc       A \"Tab\" is character 9 in the ASCII character set.  Use of the\r\nc       \"achar\" function lets me ignore the peculiarities of machine\r\nc       specific character sets. (Most are ASCII now, but IBM holds out\r\nc       with the EBCDIC set on its mainframes, and I'm suspect there are\r\nc       other's with peculiar sets.)\r\nc<a name=\"achar\"><font color=\"FF0000\">\r\n      tab=achar(9)\r\nc<\/font><\/a>\r\n      ignore=' '\/\/tab\r\nc\r\nc       Find the first character that is not in \"ignore\" (not tab or blank)\r\nc\r\n      istart= verify(string,ignore)\r\n      if(istart.ne.0) string=string(istart:lstring)\r\n      return\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     Use of the new \"achar\" and \"aichar\" is not particularly\r\nc     crucial here, so I'll leave the old ichar and char.\r\nc\r\nc     John Mahaffy  3\/8\/96\r\nc\r\n      character string*(*)\r\n      lc=len(string)\r\n      icdiff=ichar('A')-ichar('a')\r\n      do    i=1,lc\r\n         if(string(i:i).lt.'a'.or.string(i:i).gt.'z') cycle\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      end do\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 iwords(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     iwords -   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,iwords,ierr)\r\n      if (ierr.eq.1) then\r\n         write(*, *) 'Word length exceeded in line 1'\r\n      else if (ierr.eq.2) then\r\n         write (*, *) 'Nothing to parse in Line 1 ( non-fatal)'\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\nc\r\nc       Blank out the previous contents of \"oline\"\r\nc\r\n      oline=' '\r\nc\r\nc       Put only the non-blank portions of each word in to the line\r\nc\r\n      do   i=1,nwords\r\nc     <a name=3><font color=\"FF0000\">\r\n         iwords(i) =  len_trim(words(i))\r\nc    <\/font>\r\n         ilow=min(ihigh+1,loline)\r\n         ihigh=min(ihigh+iwords(i)+1 ,loline)\r\n         oline(ilow:ihigh)=words(i)(1:iwords(i))\/\/' '\r\n      end do\r\nc\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:iwords(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\n      implicit none\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    Fortran 90 Functions make this job much simpler\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      integer isym(*)\r\n      integer istart, iend, ierr, lline, nsym, lsym, nfnd, iexp, i\r\n      character line*(*),sym(*)*(*)\r\n      character (len=4) :: sep=' ,= '\r\nc\r\nc       Its easy now.  Let's add the Tab as a separator.\r\nc\r\n      sep(4:4)=achar(9)\r\n      lsym=len(sym(1))\r\n      lline=len(line)\r\n      iexp = index(line,'!')\r\n      if(iexp.gt.0) lline=iexp-1\r\n      nsym=0\r\n      ierr=0\r\n      iend=0\r\nc\r\nc       Loop to find all words (symbols) in the line\r\nc\r\n      do while (nsym.le.nfnd.and.iend.lt.lline)\r\nc\r\nc          Note how I must offset the results of verify.  Verify\r\nc          returns a value of 1 if a character not found in \"sep\"\r\nc          is located in character position iend+1 of \"line\".\r\nc\r\n         istart = verify (line((iend+1):lline),sep)+iend\r\nc<a name=\"exit\"><font color=\"FF0000\">\r\n         if(istart.eq.iend) exit\r\nc<\/font><\/a>\r\n         nsym=nsym+1\r\n         isym(nsym)=istart\r\nc <a name=4><font color=\"FF0000\">\r\n         iend = scan(line((istart+1):lline),sep)+istart-1\r\nc <\/font>\r\n         if (iend.lt.istart) iend=lline\r\n         if (iend-istart+1.le.lsym) then\r\n            sym(nsym)=line(istart:iend)\r\n            cycle\r\n         else\r\n            ierr=1\r\n            write(*,2002) lsym\r\n 2002       format(' This word has more than',i3,' characters')\r\n            call poinat(line,9,(istart+lsym\/2))\r\n            sym(nsym)= line(istart:(istart+lsym-1))\r\n         endif\r\n      end do\r\n         sym((nsym+1):nfnd)=' '\r\n      if ( nsym.eq.0) ierr=2\r\n      return\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\nc <a name=\"case\"><font color=\"FF0000\">\r\n         select case (keyword(i))\r\nc <\/a><\/font>\r\n            case ('T','TEMP','TEMPERATURE')\r\n               t=value(i)\r\n               write(*,form1) t\r\n            case ('P','PRES', 'PRESSURE')\r\n               p=value(i)\r\n               write(*,2001) p\r\n            case default\r\n               write(*,2002) i\r\n               write(*,'(a)') keyword(i)\r\n               write(*,*)\r\nc<a name=\"es\"><font color=\"FF0000\">\r\n         end select\r\nc<\/a><\/font>\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><\/pre>\n","protected":false},"excerpt":{"rendered":"
c<html> c<head><title>charvar90.f<\/title><\/head> c<body> c<pre> Program charvar90 c c Demonstrate use of character variables c Features of Fortran 90 are applied, but not all of the c Fortran 90 intrinsic functions are used. 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-203","page","type-page","status-publish","hentry"],"_links":{"self":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/203","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=203"}],"version-history":[{"count":1,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/203\/revisions"}],"predecessor-version":[{"id":204,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/203\/revisions\/204"}],"wp:attachment":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/media?parent=203"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/categories?post=203"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/tags?post=203"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}