From 2a04af87fb6a6cdbeb5577c3e65513f874074dff Mon Sep 17 00:00:00 2001 From: Brett Miller Date: Tue, 27 Mar 2018 14:58:23 +1100 Subject: [PATCH] Initial commit --- extractRMA11_csv_v4.f | 196 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 196 insertions(+) create mode 100644 extractRMA11_csv_v4.f diff --git a/extractRMA11_csv_v4.f b/extractRMA11_csv_v4.f new file mode 100644 index 0000000..5dde91a --- /dev/null +++ b/extractRMA11_csv_v4.f @@ -0,0 +1,196 @@ + PROGRAM extractrma11 + +c*************************************************************************************************** +c This program reads in a series of RMA-11 results files and outputs the list of constituents +c at selected nodes. +c +c*************************************************************************************************** + + IMPLICIT NONE + + CHARACTER*16 convtodate + + CHARACTER(len=60),dimension(:),allocatable :: rmafile + INTEGER num_rma_files + + CHARACTER(len=100),dimension(:),allocatable :: output_name + INTEGER,dimension(:),allocatable :: output_node + INTEGER num_outputs + + INTEGER i,j,k,n,nqal + + INTEGER num_nodes, num_elems, num_qual + + CHARACTER(len=8),dimension(:),allocatable :: constit + + REAL,dimension(:,:),allocatable :: vel,tcon + REAL,dimension(:),allocatable :: wsel,wd + + INTEGER IYRR + REAL TETT + + CHARACTER(len=100) :: filename + CHARACTER(len=40) :: out_prefix + CHARACTER*1000 header + + +c ------------------------------------------------------------------------------------- +c Open and Read the Config File +c-------------------------------------------------------------------------------------- + WRITE(*,'(A$)') 'Enter the config file name:' + READ(*,'(A)') filename + OPEN(UNIT=10,FILE=filename,STATUS='old') + + READ(10,'(I5)') num_rma_files + allocate(rmafile(num_rma_files)) + do i=1,num_rma_files + read(10,'(A)') rmafile(i) + enddo + + READ(10,'(A)') out_prefix + + READ(10,'(I5)') num_outputs + allocate(output_name(num_outputs)) + allocate(output_node(num_outputs)) + + do i=1,num_outputs + read(10,'(I5,3X,A)') output_node(i), output_name(i) + write(*,'(I5,A)') output_node(i),trim(output_name(i)) + enddo + + CLOSE(10) + +c ------------------------------------------------------------------------------------- +c There is an assumption that all of the RMA files have come from the same mesh +c and configuration. You could test the header of each one, but let's assume the +c user knows what they are doing. +c +c Open the first file and read the constituent list and number of nodes in the mesh +c The allocate the arrays +c ------------------------------------------------------------------------------------- + + OPEN(UNIT=20,FILE=rmafile(1),STATUS='old',FORM='binary') + READ(20) header + CLOSE(20) + READ(header(41:70),'(3I10)') num_nodes,num_elems,num_qual + allocate(constit(num_qual)) + DO i=1,num_qual + read(header(302+8*(i-1):302+8*i),'(A)') constit(i) + ENDDO + allocate(vel(3,num_nodes)) + allocate(tcon(20,num_nodes)) + allocate(wd(num_nodes)) + allocate(wsel(num_nodes)) + +c ------------------------------------------------------------------------------------- +c Open each CSV file and write the header +c-------------------------------------------------------------------------------------- + DO J=1,num_outputs + write(filename,'(A,A,A)') trim(out_prefix), + + trim(output_name(j)),'.csv' + OPEN(UNIT=J+50,FILE=filename) + + write(J+50,'(A,$)'), 'Year,Time,Date,' + DO I=1,num_qual + WRITE(J+50,('(A,$)')) constit(I),',' + ENDDO + WRITE(J+50,('(A)')) '' + ENDDO + +c ------------------------------------------------------------------------------------- +c Loop through the RMA-11 files +c-------------------------------------------------------------------------------------- + + DO i=1,num_rma_files + write(*,'(A)') rmafile(i) + OPEN(UNIT=12, FILE=rmafile(i),STATUS='OLD',FORM='BINARY') + read(12) header +100 read(12,end=200) TETT,NQAL,N,IYRR, + + ((VEL(K,J),J=1,N),K=1,3), (wd(J),J=1,N), + + (wsel(J),J=1,N), + + ((TCON(K,J),J=1,N),K=1,NQAL-5) + + DO J=1,num_outputs + WRITE(J+50,('(I4,A,F7.2,A,A16,A$)')) + + IYRR,',',TETT,',',convtodate(IYRR,TETT),',' + DO K=1,num_qual + WRITE(J+50,('(E14.7,A1,$)')) + + TCON(K,output_node(j)),',' + enddo + WRITE(J+50,('(A)')) '' + ENDDO + GOTO 100 +200 CLOSE(12) + ENDDO + +c Close the files + + DO J=1,num_outputs + CLOSE(UNIT=J+50) + ENDDO + + END + +c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +c Subroutines +c +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + CHARACTER*16 FUNCTION convtodate(IYRR,TETT) + INTEGER IYRR + REAL TETT + INTEGER year,month,day,hour,minute,jday + + jday=jd(IYRR,1,1)+floor(TETT/24.0) + CALL gdate(jday,year,month,day) + hour=mod(floor(TETT),24) + minute=int((TETT-floor(TETT))*60.0) + + write(convtodate,'(I2.2,A,I2.2,A,I4,A,I2.2,A,I2.2)') + + day,'/',month,'/',year,' ',hour,':',minute + + RETURN + END + + + INTEGER FUNCTION JD (YEAR,MONTH,DAY) +C +C--- COMPUTES THE JULIAN DATE (JD) GIVEN A GREGORIAN CALENDAR +C DATE (YEAR,MONTH,DAY). +C + INTEGER YEAR,MONTH,DAY,I,J,K +C + I= YEAR + J= MONTH + K= DAY +C + JD= K-32075+1461*(I+4800+(J-14)/12)/4+367*(J-2-(J-14)/12*12) + + /12-3*((I+4900+(J-14)/12)/100)/4 +C + RETURN + END + + SUBROUTINE GDATE (JD, YEAR,MONTH,DAY) +C +C---COMPUTES THE GREGORIAN CALENDAR DATE (YEAR,MONTH,DAY) +C GIVEN THE JULIAN DATE (JD). +C + INTEGER JD,YEAR,MONTH,DAY,I,J,K +C + L= JD+68569 + N= 4*L/146097 + L= L-(146097*N+3)/4 + I= 4000*(L+1)/1461001 + L= L-1461*I/4+31 + J= 80*L/2447 + K= L-2447*J/80 + L= J/11 + J= J+2-12*L + I= 100*(N-49)+I+L +C + YEAR= I + MONTH= J + DAY= K +C + RETURN + END +