{"id":71,"date":"2017-09-11T15:10:28","date_gmt":"2017-09-11T18:10:28","guid":{"rendered":"http:\/\/www.professores.uff.br\/diomarcesarlobao\/?page_id=71"},"modified":"2017-09-11T15:10:28","modified_gmt":"2017-09-11T18:10:28","slug":"array3as-f","status":"publish","type":"page","link":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/array3as-f\/","title":{"rendered":"array3as.f"},"content":{"rendered":"<pre>PROGRAM ARRAY3AS\r\nc\r\nc    This program illustrates use of allocatable arrays accross\r\nc    subprograms\r\nc\r\nc    John Mahaffy   2\/3\/95\r\nc\r\n      IMPLICIT NONE\r\n      INTEGER I,J,IERR,N,NDAT\r\nc\r\nc    Declare A, B, and C to be arrays to be ALLOCATABLE\r\nc\r\n      REAL, ALLOCATABLE :: A(:),B(:),C(:)\r\n      REAL CSUM,CMAX,CMIN,AVERAGE,RAVERAGE\r\nc\r\n      call size (NDAT)\r\nc\r\nc   ALLOCATE must take place at the highest level the arrays are used.\r\nc   I can't allocate the space in subroutines size or input.\r\nc\r\nc\r\n      ALLOCATE (A(1:NDAT),B(NDAT),C(NDAT))\r\nc\r\n      call input(A,B,NDAT)\r\n      if (NDAT.eq.0) then\r\n         print *, 'No Lines in the Data File'\r\n         stop\r\n      endif\r\n      call cprop(A,B,C,NDAT,AVERAGE,RAVERAGE,CMAX,CMIN)\r\n      call writec(C,NDAT,AVERAGE,RAVERAGE,CMAX,CMIN)\r\n      stop\r\n      end\r\n      SUBROUTINE SIZE  (N)\r\nc\r\nc     Read input file to determine data needs\r\nc\r\n      REAL DUMMY\r\n      INTEGER N\r\n      OPEN(11,FILE='array3a.in',ERR=400)\r\n      NDAT=0\r\n  10  READ(11,*,END=20) DUMMY\r\n      N=N+1\r\n      GO TO 10\r\n  20  CONTINUE\r\nc\r\nc    Having gone through Unit 11, I need to reposition it at the beginning\r\nc\r\n      REWIND(11)\r\n      return\r\n 400  print *, 'Can not open array3a.in'\r\n      stop\r\n      end\r\nc\r\n      SUBROUTINE INPUT (A,B,N)\r\nc\r\nc     Read A and B arrays\r\nc\r\n      REAL DUMMY,A(N),B(N)\r\n      INTEGER N\r\nc\r\n      DO 30 I=1,N\r\n         READ(11,*) A(I), B(I)\r\n  30     CONTINUE\r\n      RETURN\r\n      END\r\n      SUBROUTINE CPROP(A,B,C,NDAT,AVERAGE,RAVERAGE,CMAX,CMIN)\r\nc\r\nc    This subroutine doesn't care whether A, B, or C are allocatable.\r\nc    but I will allocate RA for internal use.\r\nc\r\n      REAL A(NDAT),B(NDAT),C(NDAT)\r\n      REAL,  ALLOCATABLE::RA(:)\r\nc\r\nc    The next line does a default allocate, because \"RB\" is not in the\r\nc    argument list, but NDAT is. RB is called an \"automatic\" array.\r\nc\r\n      REAL RB(NDAT)\r\n      REAL AVERAGE,RAVERAGE,CMAX,CMIN\r\n      INTEGER NDAT,ISTAT\r\n      LOGICAL lalloc\r\nc\r\nc   Process as before\r\nc\r\n      ALLOCATE (RA(1:NDAT))\r\n      RA(1:NDAT)=1.\/A(1:NDAT)\r\n      RB(1:NDAT)=1.\/B(1:NDAT)\r\n      C(1:NDAT)=A(1:NDAT)+B(1:NDAT)\r\n      CSUM=SUM(C(1:NDAT))\r\n      CMIN=MINVAL(C(1:NDAT))\r\n      CMAX=MAXVAL(C(1:NDAT))\r\nC\r\n      AVERAGE=CSUM\/NDAT\r\n      RAVERAGE=SUM(RA(1:NDAT)+RB(1:NDAT))\/(2*NDAT)\r\nc\r\nc    In a Program with a lot of branching,\r\nc\r\n      lalloc=allocated(RA)\r\n      print *, 'Allocation status of RA is ', lalloc\r\nc\r\nc    If you allocate an Array in a subroutine or function you should\r\nc    deallocate it before returning.  Otherwise the array enters an\r\nc    undefined state, and Fortran 90 makes no guarantees about whether\r\nc    you can reuse contents.  The memory used is wasted (can't be reused by\r\nc    another allocation, but is still credited to the total size of your\r\nc    executing program.  Also remember that the process of ALLOCATE and\r\nc    DEALLOCATE in a subroutine or function that is used many times will\r\nc    consume an excessive amount of computer time.\r\nc\r\n\r\n      if (lalloc) then\r\n         DEALLOCATE(RA,STAT=ISTAT)\r\n         if (ISTAT.NE.0) then\r\n            print *, 'Trouble deallocating RA in CPROP'\r\n         endif\r\n         lalloc=allocated(RA)\r\n         print *, 'Allocation status of RA is ', lalloc\r\n      endif\r\nc\r\nc     RB is automatically deallocated at the RETURN, but the above\r\nc     warning for excessive computer time associated with the ALLOCATE\r\nc     and DEALLOCATE cycle, applies to this array too.  In reality the\r\nc     computer treats it no differently than I have RA\r\nc\r\n      RETURN\r\n      END\r\n      SUBROUTINE WRITEC (C,NDAT,AVERAGE,RAVERAGE,CMAX,CMIN)\r\n      REAL AVERAGE,RAVERAGE,SUM,CMAX,CMIN,C(1:NDAT)\r\n      INTEGER NDAT,ISTAT\r\n      WRITE(*,'(\/\/,'' RESULTS FOR ELEMENTS 1 THROUGH '',I3,'' OF C'')')\r\n     &amp; NDAT\r\n      WRITE(6,2002)AVERAGE,CMIN,CMAX\r\n 2002 FORMAT(' AVERAGE OF SELECTED ELEMENTS IN C = ', F8.3,\/,\r\n     &amp;       ' MINIMUM OF SELECTED ELEMENTS IN C = ', F8.3,\/,\r\n     &amp;       ' MAXIMUM OF SELECTED ELEMENTS IN C = ', F8.3)\r\n      WRITE(6,*) 'Average of all reciprocals is: ',RAVERAGE\r\n      WRITE(6,2003) C(1:NDAT)\r\n 2003 FORMAT(' C = ',\/,(1P,8E10.2))\r\nc\r\n      RETURN\r\n 400  PRINT *,' Empty or missing input file: array3a.in'\r\n      RETURN\r\n      END<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>PROGRAM ARRAY3AS c c This program illustrates use of allocatable arrays accross c subprograms c c John Mahaffy 2\/3\/95 c IMPLICIT NONE INTEGER I,J,IERR,N,NDAT c c Declare A, B, and C to be arrays to be ALLOCATABLE c REAL, ALLOCATABLE :: A(:),B(:),C(:) REAL CSUM,CMAX,CMIN,AVERAGE,RAVERAGE c call size (NDAT) c c ALLOCATE must take place at [&hellip;]<\/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-71","page","type-page","status-publish","hentry"],"_links":{"self":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/71","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=71"}],"version-history":[{"count":1,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/71\/revisions"}],"predecessor-version":[{"id":72,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/71\/revisions\/72"}],"wp:attachment":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/media?parent=71"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/categories?post=71"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/tags?post=71"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}