From 3516f8eac9a01b5c29727abf9f4ba6ba6e89303c Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Mon, 28 Jul 2014 14:13:04 +0100 Subject: [PATCH 01/32] Tidied up some includes. Renamed the stuart module to default and seperated the gravity parameters into their own file. Also some comments in vacio as part of some reading. --- sac/src/vacio.t | 18 +++++++++++++++++- sac/src/{vacusr.t.stuart => vacusr.t.default} | 0 ...{vacusrpar.t.stuart => vacusrpar.gravity.t} | 0 sac/src/vacusrpar.t.default | 3 +++ 4 files changed, 20 insertions(+), 1 deletion(-) rename sac/src/{vacusr.t.stuart => vacusr.t.default} (100%) rename sac/src/{vacusrpar.t.stuart => vacusrpar.gravity.t} (100%) create mode 100644 sac/src/vacusrpar.t.default diff --git a/sac/src/vacio.t b/sac/src/vacio.t index db17bae..5a02cc8 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -714,26 +714,42 @@ SUBROUTINE readfileini_bin(w) snapshot=0 DO + ! Read filehead READ(unitini,iostat=ios) fileheadini !END=100 + IF(ios<0)EXIT ! Cycle until the last recorded state IF(oktest) WRITE(unitterm,*)'fileheadini=',fileheadini(1:30) + + ! Read params READ(unitini,iostat=ios)it,t,ndimini,neqparini,nwini IF(oktest) WRITE(unitterm, & "('it=',i7,' t=',g10.3,' ndim=',i3,' neqpar=',i3,' nw=',i3)")& it,t,ndimini,neqparini,nwini gencoord= ndimini<0 + ! Validate parameters? CALL checkNdimNeqparNw(ndimini,neqparini,nwini,neqparin,nwin) + + ! Read nx READ(unitini,iostat=ios)nx IF(oktest) WRITE(unitterm,"('nx =',3i4)")nx - CALL setixGixMix(ix^L) + ! This set's up the global indicies based on nx and also + ! deals with the MPI indicies etc. + CALL setixGixMix(ix^L) + + ! Read eqpar READ(unitini,iostat=ios)(eqpar(ieqpar),ieqpar=1,neqparin),& (eqparextra,ieqpar=neqparin+1,neqparini) IF(oktest) WRITE(unitterm,*)eqpar + + ! Read varnamesini READ(unitini,iostat=ios)varnamesini IF(varnames=='default')varnames=varnamesini IF(oktest) WRITE(unitterm,*)varnames + ! Read x array READ(unitini,iostat=ios)(x(ix^S,idim),idim=1,ndim) + + ! Read w array ! To conform savefileout_bin we use loop for iw DO iw=1,nwin READ(unitini,iostat=ios)w(ix^S,iw) diff --git a/sac/src/vacusr.t.stuart b/sac/src/vacusr.t.default similarity index 100% rename from sac/src/vacusr.t.stuart rename to sac/src/vacusr.t.default diff --git a/sac/src/vacusrpar.t.stuart b/sac/src/vacusrpar.gravity.t similarity index 100% rename from sac/src/vacusrpar.t.stuart rename to sac/src/vacusrpar.gravity.t diff --git a/sac/src/vacusrpar.t.default b/sac/src/vacusrpar.t.default new file mode 100644 index 0000000..01275e2 --- /dev/null +++ b/sac/src/vacusrpar.t.default @@ -0,0 +1,3 @@ +! Include the gravity parameters + +INCLUDE:vacusrpar.gravity.t From ab914507d50cd9269aaf68cc8abc92d4cb13f5fc Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Mon, 28 Jul 2014 14:55:45 +0100 Subject: [PATCH 02/32] Makefile now removes .mod files. Also mpi=off. --- sac/src/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sac/src/Makefile b/sac/src/Makefile index c6f28cf..f590ca6 100644 --- a/sac/src/Makefile +++ b/sac/src/Makefile @@ -86,7 +86,7 @@ vac :$(VACOBJ) $(LIBS_) ###### Removing object files, precompiled Fortran files, and symbolic links clean : - rm -f vac*$F roetest$F Vvac*$F vac*.d *$O *~ + rm -f vac*$F roetest$F Vvac*$F vac*.d *$O *~ *.mod cleanall: clean rm -f vacphys.t vacphys0.t vacpar.t vacusrpar.t vacusr.t From 55a4d11168414822fa4e3910245debf4a86cc07f Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Mon, 28 Jul 2014 14:57:11 +0100 Subject: [PATCH 03/32] mpi=off --- sac/src/vac.t | 6 +++--- sac/src/vacpp.pl | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/sac/src/vac.t b/sac/src/vac.t index 1acb0ea..920663c 100644 --- a/sac/src/vac.t +++ b/sac/src/vac.t @@ -25,9 +25,9 @@ PROGRAM vac verbose=.TRUE. .AND.ipe==0^IFMPI IF(verbose)THEN WRITE(*,'(a)')'VAC 4.52 configured to' - WRITE(*,'(a)')' -d=22 -phi=0 -z=0 -g=104,104 -p=mhd -u=stuart' - WRITE(*,'(a)')' -on=cd,rk,mpi' - WRITE(*,'(a)')' -off=mc,fct,tvdlf,tvd,impl,poisson,ct,gencoord,resist' + WRITE(*,'(a)')' -d=22 -phi=0 -z=0 -g=104,104 -p=mhd -u=default' + WRITE(*,'(a)')' -on=cd,rk' + WRITE(*,'(a)')' -off=mc,fct,tvdlf,tvd,impl,poisson,ct,gencoord,resist,mpi' {^IFMPI WRITE(*,'(a,i3,a)')'Running on ',npe,' processors'} ENDIF diff --git a/sac/src/vacpp.pl b/sac/src/vacpp.pl index c9a683d..0c203f3 100755 --- a/sac/src/vacpp.pl +++ b/sac/src/vacpp.pl @@ -17,7 +17,7 @@ $phi=-9; $z=-8; $if_cd=1; $if_mc=0; $if_fct=0; $if_tvdlf=0; $if_tvd=0; $if_impl=0; $if_poisson=0; $if_ct=0; $if_gencoord=0; $if_resist=0; $if_rk=1; -$if_mpi=1; +$if_mpi=0; # SETVAC READS UP TO THIS POINT From 10802dbc0c18d716cc20ec95be3800fddb2488ad Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Mon, 28 Jul 2014 14:57:26 +0100 Subject: [PATCH 04/32] Test run on iceberg. --- sac/par/mhdmodes | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/sac/par/mhdmodes b/sac/par/mhdmodes index 07ab21b..3730e00 100644 --- a/sac/par/mhdmodes +++ b/sac/par/mhdmodes @@ -1,11 +1,13 @@ -&testlist / +&testlist + teststr='readfileini' +/ &filelist - filenameini='/archive/mhdmodes_2D.ini' + filenameini='/data/smq11sjm/VAC/data/mhdmodes_2D.ini' typefileini='binary' - filename= '/archive/mhdmodes_2D.log', - '/archive/mhdmodes_2D.out' + filename= '/data/smq11sjm/VAC/data/mhdmodes_2D.log', + '/data/smq11sjm/VAC/data/mhdmodes_2D.out' typefileout='binary' fullgridout= T fullgridini= T From bff3cac5b53010942003a26e69e2675e609976a9 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Tue, 29 Jul 2014 11:14:50 +0100 Subject: [PATCH 05/32] Add a module for SAC gdf calls, not using vacpp --- sac/src/sacgdf.f90 | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 sac/src/sacgdf.f90 diff --git a/sac/src/sacgdf.f90 b/sac/src/sacgdf.f90 new file mode 100644 index 0000000..21b14e9 --- /dev/null +++ b/sac/src/sacgdf.f90 @@ -0,0 +1,37 @@ +module sacgdf + use hdf5 + + + +contains + + subroutine sac_gdf_read_eqpar(file_id, dimensionality) + ! Convert simulation parameters to the eqpar array + use common_variables + use hdf5, only: HID_T, h5gopen_f, h5gclose_f + use gdf_helpers, only: read_attribute + + implicit none + + integer(HID_T), intent(in) :: file_id + integer, intent(in) :: dimensionality + + + call h5gopen_f(file_id, 'simulation_parameters', g_id, error) + call read_attribute(g_id, 'gamma', eqpar(gamma_)) + call read_attribute(g_id, 'eta', eqpar(eta_)) + call read_attribute(g_id, 'gravity0', eqpar(grav0_)) + call read_attribute(g_id, 'gravity1', eqpar(grav1_)) + if (dimensionality .GE. 2) then + call read_attribute(g_id, 'gravity2', eqpar(grav2_)) + end if + if (dimensionality .EQ. 3) then + call read_attribute(g_id, 'gravity3', eqpar(grav3_)) + end if + call read_attribute(g_id, 'nu', eqpar(nu_)) + call h5close_f(g_id, error) + + + end subroutine simulation_params_eqpar_3D + +end module sacgdf From e83cd4ff75537954468c4ec8c12cdf67f93097b8 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Tue, 29 Jul 2014 13:30:04 +0100 Subject: [PATCH 06/32] Add fgdfio library, change common_variables module name and try to make it compile. --- .gitmodules | 3 ++ sac/src/Makefile | 17 ++++++--- sac/src/fgdfio | 1 + sac/src/sacgdf.f90 | 37 -------------------- sac/src/sacgdf.t | 71 ++++++++++++++++++++++++++++++++++++++ sac/src/vac.t | 20 +++++------ sac/src/vaccd.t | 2 +- sac/src/vacdef.t | 4 +-- sac/src/vacgrid.t | 14 ++++---- sac/src/vacio.t | 22 ++++++------ sac/src/vacmpi.t | 28 +++++++-------- sac/src/vacphys.mhd0.t | 14 ++++---- sac/src/vacphys.t.mhd | 2 +- sac/src/vacphys0.t.mhd | 18 +++++----- sac/src/vacusr.gravity.t | 4 +-- sac/src/vacusr.t.default | 16 ++++----- sac/src/vacusr.viscosity.t | 14 ++++---- 17 files changed, 166 insertions(+), 121 deletions(-) create mode 100644 .gitmodules create mode 160000 sac/src/fgdfio delete mode 100644 sac/src/sacgdf.f90 create mode 100644 sac/src/sacgdf.t diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..b12429c --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "sac/src/fgdfio"] + path = sac/src/fgdfio + url = https://github.com/Cadair/fgdfio.git diff --git a/sac/src/Makefile b/sac/src/Makefile index f590ca6..ac56c38 100644 --- a/sac/src/Makefile +++ b/sac/src/Makefile @@ -23,11 +23,13 @@ F=.f90 O=.o VACDIR=. +GDFDIR=fgdfio/lib/ ################# Definitions for source files ############################# -LIBS = vacdef$F -INCLUDES = vacdef$F vacpar$F vacusrpar$F +LIBS = vacdef$F sacgdf$F +INCLUDES = vacdef$F vacpar$F vacusrpar$F sacgdf$F +GDF_INCLUDES = $(GDFDIR)gdf_types.F90 $(GDFDIR)helpers_hdf5.F90 $(GDFDIR)grid_data_format.F90 VAC_FOR = vac$F vacio$F vacgrid$F vacphys0$F vacphys$F vacusr$F VAC_OBJ = vac$O vacio$O vacgrid$O vacphys0$O vacphys$O vacusr$O @@ -47,7 +49,7 @@ PREPROC= $(VACPP_) .SUFFIXES: .SUFFIXES: .t $F $O -$(VACFOR) vacini$F vacdef$F vacpar$F vacusrpar$F : $(PREPROC) +$(VACFOR) vacini$F vacdef$F vacpar$F vacusrpar$F sacgdf$F : $(PREPROC) roetest$F : $(PREPROC) $(VACOBJ) vacini$O vacall$O vaciniall$O vacsmall$O roetest$O : $(INCLUDES) @@ -62,6 +64,8 @@ vacpar$F: vacpar.t vacdef$F: vacdef.t $(VACPP) $< $(PREFOR) > $@ +sacgdf$F: sacgdf.t + $(VACPP) $< $(PREFOR) > $@ # General precompilation rule .t$(F): @@ -71,6 +75,9 @@ vacdef$F: vacdef.t $(F)$(O): $(FOR) $(FORFLG) -c $< +# Caps FORTRAN for GDF +.F90$(0): + $(FOR) $(FORFLG) -c $< ########### Extra dependencies for some files with "INCLUDE:" statements @@ -81,12 +88,12 @@ vacgrid$F: vacgrid.t $(VACPP) $< $(PREFOR) > $@ vac :$(VACOBJ) $(LIBS_) - $(FOR) $(FORFLG) -o $(VACDIR)/vac $(VACOBJ) $(LIBS) + $(FOR) $(FORFLG) -o $(VACDIR)/vac $(GDF_INCLUDES) $(VACOBJ) $(LIBS) ###### Removing object files, precompiled Fortran files, and symbolic links clean : - rm -f vac*$F roetest$F Vvac*$F vac*.d *$O *~ *.mod + rm -f vac*$F sac*$F roetest$F Vvac*$F vac*.d *$O *~ *.mod cleanall: clean rm -f vacphys.t vacphys0.t vacpar.t vacusrpar.t vacusr.t diff --git a/sac/src/fgdfio b/sac/src/fgdfio new file mode 160000 index 0000000..4d28c61 --- /dev/null +++ b/sac/src/fgdfio @@ -0,0 +1 @@ +Subproject commit 4d28c61623c65fe2b98271f2d1952fdd418ff420 diff --git a/sac/src/sacgdf.f90 b/sac/src/sacgdf.f90 deleted file mode 100644 index 21b14e9..0000000 --- a/sac/src/sacgdf.f90 +++ /dev/null @@ -1,37 +0,0 @@ -module sacgdf - use hdf5 - - - -contains - - subroutine sac_gdf_read_eqpar(file_id, dimensionality) - ! Convert simulation parameters to the eqpar array - use common_variables - use hdf5, only: HID_T, h5gopen_f, h5gclose_f - use gdf_helpers, only: read_attribute - - implicit none - - integer(HID_T), intent(in) :: file_id - integer, intent(in) :: dimensionality - - - call h5gopen_f(file_id, 'simulation_parameters', g_id, error) - call read_attribute(g_id, 'gamma', eqpar(gamma_)) - call read_attribute(g_id, 'eta', eqpar(eta_)) - call read_attribute(g_id, 'gravity0', eqpar(grav0_)) - call read_attribute(g_id, 'gravity1', eqpar(grav1_)) - if (dimensionality .GE. 2) then - call read_attribute(g_id, 'gravity2', eqpar(grav2_)) - end if - if (dimensionality .EQ. 3) then - call read_attribute(g_id, 'gravity3', eqpar(grav3_)) - end if - call read_attribute(g_id, 'nu', eqpar(nu_)) - call h5close_f(g_id, error) - - - end subroutine simulation_params_eqpar_3D - -end module sacgdf diff --git a/sac/src/sacgdf.t b/sac/src/sacgdf.t new file mode 100644 index 0000000..0d62c6d --- /dev/null +++ b/sac/src/sacgdf.t @@ -0,0 +1,71 @@ +module sacgdf + use hdf5 + + + +contains + + subroutine sacgdf_write_eqpar(file_id, dimensionality) + ! Convert simulation parameters to the eqpar array + use common_variables + use hdf5, only: HID_T, h5gopen_f, h5gclose_f + use helpers_hdf5, only: create_attribute + + implicit none + + integer(HID_T), intent(in) :: file_id + integer, intent(in) :: dimensionality + + integer(HID_T) :: g_id + integer :: error + + call h5gopen_f(file_id, 'simulation_parameters', g_id, error) + call create_attribute(g_id, 'gamma', eqpar(gamma_)) + call create_attribute(g_id, 'eta', eqpar(eta_)) + call create_attribute(g_id, 'gravity0', eqpar(grav0_)) + call create_attribute(g_id, 'gravity1', eqpar(grav1_)) + ! Read the extra parameters only if we are 2D or 3D + {^IFTWOD + call create_attribute(g_id, 'gravity2', eqpar(grav2_)) + } + {^IFTHREED + call create_attribute(g_id, 'gravity3', eqpar(grav3_)) + } + call create_attribute(g_id, 'nu', eqpar(nu_)) + call h5close_f(g_id, error) + + end subroutine sacgdf_write_eqpar + + subroutine sacgdf_read_eqpar(file_id, dimensionality) + ! Convert simulation parameters to the eqpar array + use common_variables + use hdf5, only: HID_T, h5gopen_f, h5gclose_f + use helpers_hdf5, only: read_attribute + + implicit none + + integer(HID_T), intent(in) :: file_id + integer, intent(in) :: dimensionality + + integer(HID_T) :: g_id + integer :: error + + + call h5gopen_f(file_id, 'simulation_parameters', g_id, error) + call read_attribute(g_id, 'gamma', eqpar(gamma_)) + call read_attribute(g_id, 'eta', eqpar(eta_)) + call read_attribute(g_id, 'gravity0', eqpar(grav0_)) + call read_attribute(g_id, 'gravity1', eqpar(grav1_)) + ! Read the extra parameters only if we are 2D or 3D + {^IFTWOD + call read_attribute(g_id, 'gravity2', eqpar(grav2_)) + } + {^IFTHREED + call read_attribute(g_id, 'gravity3', eqpar(grav3_)) + } + call read_attribute(g_id, 'nu', eqpar(nu_)) + call h5close_f(g_id, error) + + end subroutine sacgdf_read_eqpar + +end module sacgdf diff --git a/sac/src/vac.t b/sac/src/vac.t index 920663c..46d2f19 100644 --- a/sac/src/vac.t +++ b/sac/src/vac.t @@ -11,7 +11,7 @@ PROGRAM vac ! Pulled upto FORTRAN 2008 by Stuart Mumford 2013 USE constants - USE common_varibles + USE common_variables INTEGER:: ifile,ierrcode,iw DOUBLE PRECISION:: w(ixG^T,nw),wnrm2,dtold,time0,time1 @@ -166,7 +166,7 @@ END PROGRAM vac SUBROUTINE startup USE constants - USE common_varibles + USE common_variables INTEGER:: ifile,iw,ivector,idim,qnvector !----------------------------------------------------------------------------- @@ -235,7 +235,7 @@ SUBROUTINE advance(iws,w) ! Add split sources and fluxes with unsplit sources USE constants - USE common_varibles + USE common_variables INTEGER:: iws(niw_) DOUBLE PRECISION:: w(ixG^T,nw), w1(ixG^T,nw) @@ -299,7 +299,7 @@ SUBROUTINE advance_expl(method,ix^L,iws,w1,w) ! w1 can be ised freely. USE constants - USE common_varibles + USE common_variables CHARACTER(^LENTYPE) :: method INTEGER :: ix^L,iws(niw_) @@ -377,7 +377,7 @@ SUBROUTINE advect(method,ix^L,iws,idim^LIM,w1,w,firstsweep,lastsweep) ! Depending on typeadvance and implpar call advect1 several times USE constants - USE common_varibles + USE common_variables CHARACTER(^LENTYPE):: method INTEGER:: ix^L,iws(niw_),idim^LIM @@ -502,7 +502,7 @@ SUBROUTINE advect1(method,qdt,ixI^L,iws,idim^LIM,qtC,wCT,qt,w,firstsweep,lastswe ! getboundaries USE constants - USE common_varibles + USE common_variables CHARACTER(^LENTYPE) :: method INTEGER:: ixI^L,ixO^L,iws(niw_),idim^LIM,idim @@ -562,7 +562,7 @@ SUBROUTINE addsource2(qdt,ixII^L,ixOO^L,iws,qtC,wCT,qt,w) ! Add source within ixOO for iws: w=w+qdt*S[wCT] USE constants - USE common_varibles + USE common_variables INTEGER:: ixI^L,ixO^L,ixII^L,ixOO^L,iws(niw_) DOUBLE PRECISION:: qdt,qtC,qt,wCT(ixG^T,nw),w(ixG^T,nw) @@ -597,7 +597,7 @@ LOGICAL FUNCTION timetofinish(time0) ! or residual is small enough. Other conditions may be included. USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: time0, cputime LOGICAL:: okfinish @@ -622,7 +622,7 @@ LOGICAL FUNCTION timetosave(ifile) ! Other conditions may be included. USE constants - USE common_varibles + USE common_variables INTEGER:: ifile LOGICAL:: oksave @@ -661,7 +661,7 @@ SUBROUTINE getdt_courant(w,ix^L) ! rotations while the value calculated here does not use a rotation. USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw),cmax(ixG^T),courantmax,dtold INTEGER:: ix^L,idim diff --git a/sac/src/vaccd.t b/sac/src/vaccd.t index 18dda7a..71d87a7 100644 --- a/sac/src/vaccd.t +++ b/sac/src/vaccd.t @@ -13,7 +13,7 @@ SUBROUTINE centdiff4(qdt,ixI^L,ixO^L,iws,idim^LIM,qtC,wCT,qt,w) ! w is the old value at qt on input and the new value at qt+qdt on output. USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: qdt,qtC,qt,wCT(ixG^T,nw),w(ixG^T,nw) INTEGER:: ixI^L,ixO^L,iws(niw_),idim^LIM diff --git a/sac/src/vacdef.t b/sac/src/vacdef.t index 962839f..ecee484 100644 --- a/sac/src/vacdef.t +++ b/sac/src/vacdef.t @@ -89,7 +89,7 @@ MODULE constants END MODULE constants -MODULE common_varibles +module common_variables USE constants SAVE @@ -202,4 +202,4 @@ MODULE common_varibles DOUBLE PRECISION:: maxviscoef -END MODULE common_varibles +end module common_variables diff --git a/sac/src/vacgrid.t b/sac/src/vacgrid.t index a29d57e..a7db05f 100644 --- a/sac/src/vacgrid.t +++ b/sac/src/vacgrid.t @@ -19,7 +19,7 @@ SUBROUTINE boundsetup ! typeB(iw,iB) - boundary type string USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L,iB,jB,iw,idim,idm,ixG^LIM(ndim),ixM^LIM(ndim) !----------------------------------------------------------------------------- @@ -168,7 +168,7 @@ SUBROUTINE ensurebound(dix,ixI^L,ixO^L,qt,w) ! Adjust ixI and ixO. Call getboundary if needed. USE constants - USE common_varibles + USE common_variables INTEGER:: dix,ixI^L,ixO^L DOUBLE PRECISION:: qt,w(ixG^T,nw) @@ -197,7 +197,7 @@ END SUBROUTINE ensurebound SUBROUTINE getboundary(qt,iw^LIM,idim^LIM,w) USE constants - USE common_varibles + USE common_variables INTEGER:: iw^LIM,idim^LIM DOUBLE PRECISION:: qt,w(ixG^T,1:nw) @@ -522,7 +522,7 @@ SUBROUTINE setnoflux(iw,idim,ix^L,fRC,ixR^L,fLC,ixL^L) ! in a boundary region USE constants - USE common_varibles + USE common_variables INTEGER:: iw,idim,ix^L,ixL^L,ixR^L DOUBLE PRECISION:: fRC(ixG^T), fLC(ixG^T) @@ -569,7 +569,7 @@ SUBROUTINE gridsetup1 ! qx - x with an extended index range for calculation of dx USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L,hx^L,jx^L INTEGER:: ix,ixe,ixf,idim,jdim @@ -671,7 +671,7 @@ END SUBROUTINE gridsetup1 SUBROUTINE gradient4(realgrad,q,ix^L,idim,gradq) USE constants - USE common_varibles + USE common_variables LOGICAL:: realgrad INTEGER:: ix^L,idim @@ -731,7 +731,7 @@ SUBROUTINE laplace4(q,ix^L,laplaceq) !!! We assume uniform Cartesian grid in slab symmetry for now USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L DOUBLE PRECISION:: q(ixG^T),laplaceq(ixG^T) diff --git a/sac/src/vacio.t b/sac/src/vacio.t index 5a02cc8..7c13585 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -10,7 +10,7 @@ SUBROUTINE readparameters(w) ! from the parameter file. USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw) @@ -542,7 +542,7 @@ SUBROUTINE readfileini(w) ! read. The compatibility of initial data with internal parameters is checked. USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw) @@ -615,7 +615,7 @@ SUBROUTINE readfileini_asc(w) ! w - the initial flow variables USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw) @@ -691,7 +691,7 @@ SUBROUTINE readfileini_bin(w) ! The compatibility of initial data with internal parameters is checked. USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw) @@ -778,7 +778,7 @@ END SUBROUTINE readfileini_bin SUBROUTINE checkNdimNeqparNw(ndimini,neqparini,nwini,neqparin,nwin) USE constants - USE common_varibles + USE common_variables INTEGER:: ndimini,neqparini,nwini,neqparin,nwin !----------------------------------------------------------------------------- @@ -811,7 +811,7 @@ END SUBROUTINE checkNdimNeqparNw SUBROUTINE setixGixMix(ix^L) USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L,qnx^IFMPI !----------------------------------------------------------------------------- @@ -871,7 +871,7 @@ SUBROUTINE setheaderstrings ! Check and/or put physics and equation parameter names into file header USE constants - USE common_varibles + USE common_variables INTEGER:: i CHARACTER(^LENTYPE) :: physics @@ -927,7 +927,7 @@ END SUBROUTINE setheaderstrings SUBROUTINE savefile(ifile,w) USE constants - USE common_varibles + USE common_variables INTEGER:: ifile,ix^L DOUBLE PRECISION:: w(ixG^T,nw) @@ -991,7 +991,7 @@ SUBROUTINE savefileout_asc(qunit,w,ix^L) ! line is fileheadout and not fileheadini. USE constants - USE common_varibles + USE common_variables INTEGER:: qunit,ix^L,ix^D,iw,idim,ndimout DOUBLE PRECISION:: w(ixG^T,nw),qw(nw) @@ -1036,7 +1036,7 @@ SUBROUTINE savefileout_bin(qunit,w,ix^L) ! line is fileheadout and not fileheadini. USE constants - USE common_varibles + USE common_variables INTEGER:: qunit,ix^L,idim,iw,ndimout DOUBLE PRECISION:: w(ixG^T,nw) @@ -1129,7 +1129,7 @@ SUBROUTINE savefilelog_default(qunit,w,ix^L) ! if residmin>0 is set in the parfile. USE constants - USE common_varibles + USE common_variables INTEGER:: qunit,ix^L DOUBLE PRECISION:: w(ixG^T,nw) diff --git a/sac/src/vacmpi.t b/sac/src/vacmpi.t index 3ddc131..52b8e8e 100644 --- a/sac/src/vacmpi.t +++ b/sac/src/vacmpi.t @@ -4,7 +4,7 @@ SUBROUTINE mpiinit ! Initialize MPI variables USE constants - USE common_varibles + USE common_variables !---------------------------------------------------------------------------- CALL MPI_INIT(ierrmpi) CALL MPI_COMM_RANK (MPI_COMM_WORLD, ipe, ierrmpi) @@ -22,7 +22,7 @@ END SUBROUTINE mpiinit SUBROUTINE mpifinalize USE constants - USE common_varibles + USE common_variables CALL MPI_BARRIER(MPI_COMM_WORLD,ierrmpi) CALL MPI_FINALIZE(ierrmpi) @@ -36,7 +36,7 @@ SUBROUTINE ipe2ipeD(qipe,qipe^D) ! Convert serial processor index to directional processor indexes USE constants - USE common_varibles + USE common_variables INTEGER:: qipe^D, qipe !----------------------------------------------------------------------------- @@ -53,7 +53,7 @@ SUBROUTINE ipeD2ipe(qipe^D,qipe) ! Convert directional processor indexes to serial processor index USE constants - USE common_varibles + USE common_variables INTEGER:: qipe^D, qipe !----------------------------------------------------------------------------- @@ -70,7 +70,7 @@ SUBROUTINE mpisetnpeDipeD(name) ! For example _np0203 means np1=2, np2=3 for 2D. USE constants - USE common_varibles + USE common_variables CHARACTER(^LENNAME) :: name, nametail INTEGER:: i,qnpe^D LOGICAL:: npeDknown,npeDinname @@ -150,7 +150,7 @@ SUBROUTINE mpineighbors(idir,hpe,jpe) ! direction. USE constants - USE common_varibles + USE common_variables INTEGER :: idir,hpe,jpe,hpe^D,jpe^D !----------------------------------------------------------------------------- @@ -171,7 +171,7 @@ SUBROUTINE mpigridsetup ! Distribute a grid of size nxall^D onto PE-s arranged in a cube of size npe^D USE constants - USE common_varibles + USE common_variables !----------------------------------------------------------------------------- !!!write(*,*)'nxall,npe=',nxall^D,npe^D @@ -238,7 +238,7 @@ SUBROUTINE mpiix(ix^D,jpe) ! and set the processor number jpe to the processor that contains the cell USE constants - USE common_varibles + USE common_variables INTEGER :: ix^D, jpe, jpe^D !----------------------------------------------------------------------------- @@ -260,7 +260,7 @@ SUBROUTINE mpiixlimits(ix^L) ! Convert global index limits to local index limits for this PE USE constants - USE common_varibles + USE common_variables INTEGER :: ix^L !----------------------------------------------------------------------------- {^DLOOP @@ -285,7 +285,7 @@ SUBROUTINE mpistop(message) ! Stop MPI run in an orderly fashion USE constants - USE common_varibles + USE common_variables CHARACTER(*) :: message INTEGER :: nerrmpi @@ -304,7 +304,7 @@ SUBROUTINE mpibound(nvar,var) ! Fill in ghost cells of var(ixG,nvar) from other processors USE constants - USE common_varibles + USE common_variables INTEGER :: nvar DOUBLE PRECISION :: var(ixG^T,nvar) @@ -382,7 +382,7 @@ SUBROUTINE mpisend(nvar,var,ix^L,qipe,iside) ! jside is 0 for min and 1 for max side of the grid for the sending PE USE constants - USE common_varibles + USE common_variables INTEGER :: nvar DOUBLE PRECISION :: var(ixG^T,nvar) @@ -416,7 +416,7 @@ SUBROUTINE mpirecvbuffer(nvar,ix^L,qipe,iside) ! and sent from side iside of the grid USE constants - USE common_varibles + USE common_variables INTEGER:: nvar, ix^L, qipe, iside, n @@ -444,7 +444,7 @@ SUBROUTINE mpibuffer2var(iside,nvar,var,ix^L) ! Copy mpibuffer(:,iside) into var(ix^L,1:nvar) USE constants - USE common_varibles + USE common_variables INTEGER :: nvar DOUBLE PRECISION:: var(ixG^T,nvar) diff --git a/sac/src/vacphys.mhd0.t b/sac/src/vacphys.mhd0.t index b221ece..deac38f 100644 --- a/sac/src/vacphys.mhd0.t +++ b/sac/src/vacphys.mhd0.t @@ -11,7 +11,7 @@ SUBROUTINE physini ! Tell VAC which variables are vectors, set default entropy coefficients USE constants - USE common_varibles + USE common_variables INTEGER:: il !----------------------------------------------------------------------------- @@ -41,7 +41,7 @@ SUBROUTINE process(count,idim^LIM,w) ! count=ifile+2 for saving results into the file indexed by ifile USE constants - USE common_varibles + USE common_variables INTEGER:: count,idim^LIM DOUBLE PRECISION:: w(ixG^T,nw) @@ -88,7 +88,7 @@ SUBROUTINE getdt(w,ix^L) ! If resistivity is not zero, check diffusion time limit for dt USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw) INTEGER:: ix^L @@ -112,7 +112,7 @@ SUBROUTINE getdivb(w,ixO^L,divb) ! Calculate div B within ixO USE constants - USE common_varibles + USE common_variables INTEGER:: ixO^L,ix^L,idim DOUBLE PRECISION:: w(ixG^T,nw),divb(ixG^T) @@ -155,7 +155,7 @@ SUBROUTINE getflux(w,ix^L,iw,idim,f,transport) ! Set transport=.true. if a transport flux should be added USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L,iw,idim DOUBLE PRECISION:: w(ixG^T,nw),f(ixG^T), fb(ixG^T) @@ -236,7 +236,7 @@ SUBROUTINE addsource(qdt,ixI^L,ixO^L,iws,qtC,w,qt,wnew) ! Add sources from resistivity and Powell solver USE constants - USE common_varibles + USE common_variables INTEGER:: ixI^L,ixO^L,iws(niw_) DOUBLE PRECISION:: qdt,qtC,qt,w(ixG^T,nw),wnew(ixG^T,nw) @@ -276,7 +276,7 @@ SUBROUTINE addsource_divb(qdt,ixI^L,ixO^L,iws,qtC,w,qt,wnew) ! otherwise shrink ixO USE constants - USE common_varibles + USE common_variables INTEGER:: ixI^L,ixO^L,iws(niw_),iiw,iw DOUBLE PRECISION:: qdt,qtC,qt,w(ixG^T,nw),wnew(ixG^T,nw) diff --git a/sac/src/vacphys.t.mhd b/sac/src/vacphys.t.mhd index 909aac4..0244a13 100644 --- a/sac/src/vacphys.t.mhd +++ b/sac/src/vacphys.t.mhd @@ -10,7 +10,7 @@ SUBROUTINE keeppositive(ix^L,w) ! Keep pressure and density positive (following D.Ryu) USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L DOUBLE PRECISION:: w(ixG^T,nw) diff --git a/sac/src/vacphys0.t.mhd b/sac/src/vacphys0.t.mhd index 32dd0da..d5c3597 100644 --- a/sac/src/vacphys0.t.mhd +++ b/sac/src/vacphys0.t.mhd @@ -7,7 +7,7 @@ SUBROUTINE conserve(ix^L,w) ! Transform primitive variables into conservative ones USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L DOUBLE PRECISION:: w(ixG^T,nw) @@ -34,7 +34,7 @@ SUBROUTINE primitive(ix^L,w) ! Transform conservative variables into primitive ones USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L DOUBLE PRECISION:: w(ixG^T,nw) @@ -59,7 +59,7 @@ SUBROUTINE getv(w,ix^L,idim,v) ! Calculate v_idim=m_idim/rho within ix USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L,idim DOUBLE PRECISION:: w(ixG^T,nw),v(ixG^T) @@ -85,7 +85,7 @@ SUBROUTINE getcmax(new_cmax,w,ix^L,idim,cmax) ! perpendicular to the magnetic field, and cs is the sound speed. USE constants - USE common_varibles + USE common_variables LOGICAL:: new_cmax INTEGER:: ix^L,idim @@ -123,7 +123,7 @@ SUBROUTINE getcsound2prim(w,ix^L,csound2) ! csound2=gamma*p/rho USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw),csound2(ixG^T) INTEGER:: ix^L @@ -145,7 +145,7 @@ SUBROUTINE getcsound2(w,ix^L,csound2) ! csound2=gamma*p/rho USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw),csound2(ixG^T) INTEGER:: ix^L @@ -172,7 +172,7 @@ SUBROUTINE getpthermal(w,ix^L,p) USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw),p(ixG^T) INTEGER:: ix^L @@ -193,7 +193,7 @@ END SUBROUTINE getpthermal SUBROUTINE getptotal(w,ix^L,p) USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw),p(ixG^T),gamma INTEGER:: ix^L @@ -216,7 +216,7 @@ END SUBROUTINE getptotal SUBROUTINE getptotal_bg(w,ix^L,p) USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw),p(ixG^T),gamma INTEGER:: ix^L diff --git a/sac/src/vacusr.gravity.t b/sac/src/vacusr.gravity.t index 1f7fa60..55c4a0b 100644 --- a/sac/src/vacusr.gravity.t +++ b/sac/src/vacusr.gravity.t @@ -27,7 +27,7 @@ SUBROUTINE addsource_grav(qdt,ixI^L,ixO^L,iws,qtC,w,qt,wnew) ! in iws. w is at time qtC, wnew is advanced from qt to qt+qdt. USE constants - USE common_varibles + USE common_variables INTEGER:: ixI^L,ixO^L,iws(niw_) DOUBLE PRECISION:: qdt,qtC,qt,w(ixG^T,nw),wnew(ixG^T,nw) @@ -98,7 +98,7 @@ END SUBROUTINE addsource_grav SUBROUTINE getdt_grav(w,ix^L) USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION :: w(ixG^T,nw) INTEGER :: ix^L,idim diff --git a/sac/src/vacusr.t.default b/sac/src/vacusr.t.default index 412cb9c..ade5144 100644 --- a/sac/src/vacusr.t.default +++ b/sac/src/vacusr.t.default @@ -12,7 +12,7 @@ SUBROUTINE specialini(ix^L,w) ! Initialize w for VACINI, user-defined USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L DOUBLE PRECISION:: w(ixG^T,nw) @@ -28,7 +28,7 @@ SUBROUTINE specialbound(qt,ix^L,iw,iB,w) ! Calculates the boundary values in the iB-th boundary segment, user-defined USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L,iw,iB DOUBLE PRECISION:: qt,w(ixG^T,nw) @@ -59,7 +59,7 @@ SUBROUTINE specialsource(qdt,ixI^L,ixO^L,iws,qtC,wCT,qt,w) ! where "dix" is the number of extra layers needed, typically 1 or 2. USE constants - USE common_varibles + USE common_variables INTEGER:: ixI^L,ixO^L,iws(niw_) DOUBLE PRECISION:: qdt,qtC,qt,wCT(ixG^T,nw),w(ixG^T,nw) @@ -79,7 +79,7 @@ SUBROUTINE getdt_special(w,ix^L) ! module have already been called. USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw) INTEGER:: ix^L @@ -103,7 +103,7 @@ SUBROUTINE specialeta(w,ix^L,idirmin) ! and/or local values (ix) of "current" only, i.e. it has to be compact. USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw) INTEGER:: ix^L,idirmin @@ -119,7 +119,7 @@ SUBROUTINE readfileini_special(w) ! Check readfileini_asc and readfileini_bin in vacio.t on what should be done. USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw) !----------------------------------------------------------------------------- @@ -133,7 +133,7 @@ SUBROUTINE savefileout_special(qunit,w,ix^L) ! Check savefileout_asc and savefileout_bin in vacio.t on what should be done. USE constants - USE common_varibles + USE common_variables INTEGER:: qunit,ix^L DOUBLE PRECISION:: w(ixG^T,nw) @@ -148,7 +148,7 @@ SUBROUTINE savefilelog_special(qunit,w,ix^L) ! Check savefilelog_default on opening the file etc. USE constants - USE common_varibles + USE common_variables INTEGER:: qunit,ix^L DOUBLE PRECISION:: w(ixG^T,nw) diff --git a/sac/src/vacusr.viscosity.t b/sac/src/vacusr.viscosity.t index c2ec2d9..e0bfe99 100644 --- a/sac/src/vacusr.viscosity.t +++ b/sac/src/vacusr.viscosity.t @@ -4,7 +4,7 @@ SUBROUTINE addsource_visc(qdt,ixI^L,ixO^L,iws,qtC,w,qt,wnew) ! Add viscosity source to wnew within ixO USE constants - USE common_varibles + USE common_variables INTEGER:: ixI^L,ixO^L,iws(niw_) DOUBLE PRECISION:: qdt,qtC,qt,w(ixG^T,nw),wnew(ixG^T,nw) @@ -227,7 +227,7 @@ SUBROUTINE setnu(w,iw,idim,ix^L,nuR,nuL) ! Set the viscosity coefficient nu within ixO based on w(ixI). USE constants - USE common_varibles + USE common_variables INTEGER:: ixi^L DOUBLE PRECISION:: w(ixG^T,nw) @@ -462,7 +462,7 @@ END SUBROUTINE setnu SUBROUTINE setnushk(w,ix^L,nushk) USE constants - USE common_varibles + USE common_variables !double precision:: w(ixG^T,nw),tmp2(ixG^T),nushk(ixG^T,ndim) DOUBLE PRECISION:: w(ixG^T,nw),nushk(ixG^T,ndim) @@ -516,7 +516,7 @@ SUBROUTINE getdt_visc(w,ix^L) ! Based on Hirsch volume 2, p.631, eq.23.2.17 USE constants - USE common_varibles + USE common_variables DOUBLE PRECISION:: w(ixG^T,nw),dtdiff_visc INTEGER:: ix^L,idim, ix_1,ix_2 @@ -550,7 +550,7 @@ END SUBROUTINE getdt_visc SUBROUTINE gradient1(q,ix^L,idim,gradq) USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L,idim DOUBLE PRECISION:: q(ixG^T),gradq(ixG^T) INTEGER:: hx^L,kx^L @@ -597,7 +597,7 @@ END SUBROUTINE gradient1 SUBROUTINE gradient1L(q,ix^L,idim,gradq) USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L,idim DOUBLE PRECISION:: q(ixG^T),gradq(ixG^T) INTEGER:: hx^L @@ -642,7 +642,7 @@ END SUBROUTINE gradient1L SUBROUTINE gradient1R(q,ix^L,idim,gradq) USE constants - USE common_varibles + USE common_variables INTEGER:: ix^L,idim DOUBLE PRECISION:: q(ixG^T),gradq(ixG^T) INTEGER:: hx^L From d273315a94a3087283a0f6c239128654f5a62e44 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Tue, 29 Jul 2014 18:23:58 +0100 Subject: [PATCH 07/32] Big commit, but SAC is now saving GDF files!! --- sac/par/mhdmodes | 12 +- sac/src/Makefile | 21 ++-- sac/src/sacgdf.t | 251 +++++++++++++++++++++++++++++++------ sac/src/vac.t | 22 ++-- sac/src/vaccd.t | 4 +- sac/src/vacdef.t | 52 ++++---- sac/src/vacgrid.t | 16 +-- sac/src/vacio.t | 111 ++++++++++++++-- sac/src/vacmpi.t | 10 +- sac/src/vacphys.mhd0.t | 16 +-- sac/src/vacphys.t.mhd | 2 +- sac/src/vacphys0.t.mhd | 20 +-- sac/src/vacusr.gravity.t | 6 +- sac/src/vacusr.t.default | 16 +-- sac/src/vacusr.viscosity.t | 60 ++++----- 15 files changed, 442 insertions(+), 177 deletions(-) diff --git a/sac/par/mhdmodes b/sac/par/mhdmodes index 3730e00..8ef0abf 100644 --- a/sac/par/mhdmodes +++ b/sac/par/mhdmodes @@ -3,18 +3,18 @@ / &filelist - filenameini='/data/smq11sjm/VAC/data/mhdmodes_2D.ini' + filenameini='/archive/io_testing/mhdmodes_2D.ini' typefileini='binary' - filename= '/data/smq11sjm/VAC/data/mhdmodes_2D.log', - '/data/smq11sjm/VAC/data/mhdmodes_2D.out' - typefileout='binary' - fullgridout= T + filename= '/archive/mhdmodes_2D.log', + '/archive/mhdmodes_2D_' + typefileout='gdf' + fullgridout= F fullgridini= T / &savelist - dtsave=0.1,0.0001 + dtsave=1,0.1 / diff --git a/sac/src/Makefile b/sac/src/Makefile index ac56c38..0ba9dd4 100644 --- a/sac/src/Makefile +++ b/sac/src/Makefile @@ -23,13 +23,13 @@ F=.f90 O=.o VACDIR=. -GDFDIR=fgdfio/lib/ +GDFDIR=./fgdfio/lib ################# Definitions for source files ############################# LIBS = vacdef$F sacgdf$F INCLUDES = vacdef$F vacpar$F vacusrpar$F sacgdf$F -GDF_INCLUDES = $(GDFDIR)gdf_types.F90 $(GDFDIR)helpers_hdf5.F90 $(GDFDIR)grid_data_format.F90 +GDF_INCLUDES = $(GDFDIR)/gdf_types.F90 $(GDFDIR)/helpers_hdf5.F90 $(GDFDIR)/grid_data_format.F90 $(GDFDIR)/data_writers_beta.F90 VAC_FOR = vac$F vacio$F vacgrid$F vacphys0$F vacphys$F vacusr$F VAC_OBJ = vac$O vacio$O vacgrid$O vacphys0$O vacphys$O vacusr$O @@ -49,10 +49,10 @@ PREPROC= $(VACPP_) .SUFFIXES: .SUFFIXES: .t $F $O -$(VACFOR) vacini$F vacdef$F vacpar$F vacusrpar$F sacgdf$F : $(PREPROC) +$(VACFOR) vacini$F vacdef$F vacpar$F vacusrpar$F sacgdf$F : $(PREPROC) roetest$F : $(PREPROC) -$(VACOBJ) vacini$O vacall$O vaciniall$O vacsmall$O roetest$O : $(INCLUDES) +$(VACOBJ) vacini$O vacall$O vaciniall$O vacsmall$O roetest$O sacgdf$0 : $(INCLUDES) vacusrpar$F: vacusrpar.t $(VACPP) $< $(PREFOR) > $@ @@ -66,6 +66,7 @@ vacdef$F: vacdef.t sacgdf$F: sacgdf.t $(VACPP) $< $(PREFOR) > $@ + $(FOR) -c sacgdf.f90 # General precompilation rule .t$(F): @@ -75,11 +76,6 @@ sacgdf$F: sacgdf.t $(F)$(O): $(FOR) $(FORFLG) -c $< -# Caps FORTRAN for GDF -.F90$(0): - $(FOR) $(FORFLG) -c $< - - ########### Extra dependencies for some files with "INCLUDE:" statements vacphys$F: vacphys.t vacphys.mhd0.t vacphys.mhdres.t $(VACPP) $< $(PREFOR) > $@ @@ -87,8 +83,11 @@ vacphys$F: vacphys.t vacphys.mhd0.t vacphys.mhdres.t vacgrid$F: vacgrid.t $(VACPP) $< $(PREFOR) > $@ -vac :$(VACOBJ) $(LIBS_) - $(FOR) $(FORFLG) -o $(VACDIR)/vac $(GDF_INCLUDES) $(VACOBJ) $(LIBS) +gdf : + $(FOR) $(FORFLG) -c $(GDF_INCLUDES) + +vac : gdf $(VACOBJ) $(LIBS_) + $(FOR) $(FORFLG) -o $(VACDIR)/vac $(VACOBJ) $(LIBS) $(GDF_INCLUDES) ###### Removing object files, precompiled Fortran files, and symbolic links diff --git a/sac/src/sacgdf.t b/sac/src/sacgdf.t index 0d62c6d..3f7bb8c 100644 --- a/sac/src/sacgdf.t +++ b/sac/src/sacgdf.t @@ -1,11 +1,28 @@ module sacgdf use hdf5 +contains + + subroutine sacgdf_write_file(file_id, rd, gdf_sp, field_types) + use hdf5, only: HID_T + use gdf, only: gdf_write_file, gdf_root_datasets_T, gdf_parameters_T, gdf_field_type_T + implicit none + + integer(HID_T), intent(inout) :: file_id + type(gdf_root_datasets_T), intent(in) :: rd + type(gdf_parameters_T), intent(in) :: gdf_sp + type(gdf_field_type_T), dimension(:), intent(in) :: field_types + + call gdf_write_file(file_id, "Sheffield Advanced Code", "GDF Testing version", & + rd, gdf_sp, field_types) + + call sacgdf_write_eqpar(file_id) + + end subroutine sacgdf_write_file -contains - subroutine sacgdf_write_eqpar(file_id, dimensionality) + subroutine sacgdf_write_eqpar(file_id) ! Convert simulation parameters to the eqpar array use common_variables use hdf5, only: HID_T, h5gopen_f, h5gclose_f @@ -14,58 +31,220 @@ contains implicit none integer(HID_T), intent(in) :: file_id - integer, intent(in) :: dimensionality integer(HID_T) :: g_id integer :: error + real(kind=8), dimension(:), pointer :: r_ptr call h5gopen_f(file_id, 'simulation_parameters', g_id, error) - call create_attribute(g_id, 'gamma', eqpar(gamma_)) - call create_attribute(g_id, 'eta', eqpar(eta_)) - call create_attribute(g_id, 'gravity0', eqpar(grav0_)) - call create_attribute(g_id, 'gravity1', eqpar(grav1_)) + + r_ptr => eqpar(gamma_:gamma_) + call create_attribute(g_id, 'gamma', r_ptr) + + r_ptr => eqpar(eta_:eta_) + call create_attribute(g_id, 'eta', r_ptr) + + r_ptr => eqpar(grav0_:grav0_) + call create_attribute(g_id, 'gravity0', r_ptr) + + r_ptr => eqpar(grav1_:grav1_) + call create_attribute(g_id, 'gravity1', r_ptr) + ! Read the extra parameters only if we are 2D or 3D {^IFTWOD - call create_attribute(g_id, 'gravity2', eqpar(grav2_)) + r_ptr => eqpar(grav2_:grav2_) + call create_attribute(g_id, 'gravity2', r_ptr) + } {^IFTHREED - call create_attribute(g_id, 'gravity3', eqpar(grav3_)) + r_ptr => eqpar(grav3_:grav3_) + call create_attribute(g_id, 'gravity3', } - call create_attribute(g_id, 'nu', eqpar(nu_)) - call h5close_f(g_id, error) + + r_ptr => eqpar(nu_:nu_) + call create_attribute(g_id, 'nu', r_ptr) + + call h5gclose_f(g_id, error) end subroutine sacgdf_write_eqpar - - subroutine sacgdf_read_eqpar(file_id, dimensionality) - ! Convert simulation parameters to the eqpar array - use common_variables - use hdf5, only: HID_T, h5gopen_f, h5gclose_f - use helpers_hdf5, only: read_attribute + subroutine sacgdf_make_field_types(field_types) + + use common_variables, only: nw + use gdf, only: gdf_field_type_T implicit none - integer(HID_T), intent(in) :: file_id - integer, intent(in) :: dimensionality + type(gdf_field_type_T), dimension(nw), intent(inout) :: field_types + + select case (nw) + case (7) + call sacgdf_make_field_types_1D(field_types) + case (10) + call sacgdf_make_field_types_2D(field_types) + case (13) + call sacgdf_make_field_types_3D(field_types) + case default + call die("Wrong nw") + end select - integer(HID_T) :: g_id - integer :: error + end subroutine sacgdf_make_field_types + + + subroutine sacgdf_make_field_types_1D(field_types) + + use gdf, only: gdf_field_type_T + implicit none + + type(gdf_field_type_T), dimension(7), intent(inout) :: field_types + ! Write Field Type information + call field_types(1)%init() + field_types(1)%field_to_cgs = 0.001 + field_types(1)%staggering = 0 + field_types(1)%field_units = "kg m^{-3}" + field_types(1)%variable_name = "density_pert" + field_types(1)%field_name = "Pertubation Density" - call h5gopen_f(file_id, 'simulation_parameters', g_id, error) - call read_attribute(g_id, 'gamma', eqpar(gamma_)) - call read_attribute(g_id, 'eta', eqpar(eta_)) - call read_attribute(g_id, 'gravity0', eqpar(grav0_)) - call read_attribute(g_id, 'gravity1', eqpar(grav1_)) - ! Read the extra parameters only if we are 2D or 3D - {^IFTWOD - call read_attribute(g_id, 'gravity2', eqpar(grav2_)) - } - {^IFTHREED - call read_attribute(g_id, 'gravity3', eqpar(grav3_)) - } - call read_attribute(g_id, 'nu', eqpar(nu_)) - call h5close_f(g_id, error) + call field_types(2)%init() + field_types(2)%field_to_cgs = 0.001 + field_types(2)%staggering = 0 + field_types(2)%field_units = "kg m^{-3}" + field_types(2)%variable_name = "density_bg" + field_types(2)%field_name = "Background Density" + + call field_types(3)%init() + field_types(3)%field_to_cgs = 100 + field_types(3)%staggering = 0 + field_types(3)%field_units = "ms^{-1}" + field_types(3)%variable_name = "velocity_x" + field_types(3)%field_name = "x Component of Velocity" + + call field_types(4)%init() + field_types(4)%field_to_cgs = 10 + field_types(4)%staggering = 0 + field_types(4)%field_units = "Pa" + field_types(4)%variable_name = "internal_energy_pert" + field_types(4)%field_name = "Pertubation Internal Energy" + + call field_types(5)%init() + field_types(5)%field_to_cgs = 10 + field_types(5)%staggering = 0 + field_types(5)%field_units = "Pa" + field_types(5)%variable_name = "internal_energy_bg" + field_types(5)%field_name = "Background Internal Energy" + + call field_types(6)%init() + field_types(6)%field_to_cgs = 10000.0 + field_types(6)%staggering = 0 + field_types(6)%field_units = "T" + field_types(6)%variable_name = "mag_field_x_bg" + field_types(6)%field_name = "x Component of Background Magnetic Field" + + call field_types(7)%init() + field_types(7)%field_to_cgs = 10000.0 + field_types(7)%staggering = 0 + field_types(7)%field_units = "T" + field_types(7)%variable_name = "mag_field_x_pert" + field_types(7)%field_name = "x Component of Pertubation Magnetic Field" + + end subroutine sacgdf_make_field_types_1D + + subroutine sacgdf_make_field_types_2D(field_types) + + use gdf, only: gdf_field_type_T + use common_variables, only: nw + implicit none + + type(gdf_field_type_T), dimension(10), intent(inout) :: field_types - end subroutine sacgdf_read_eqpar + call sacgdf_make_field_types_1D(field_types(1:7)) + + call field_types(8)%init() + field_types(8)%field_to_cgs = 100 + field_types(8)%staggering = 0 + field_types(8)%field_units = "ms^{-1}" + field_types(8)%variable_name = "velocity_y" + field_types(8)%field_name = "y Component of Velocity" + + call field_types(9)%init() + field_types(9)%field_to_cgs = 10000.0 + field_types(9)%staggering = 0 + field_types(9)%field_units = "T" + field_types(9)%variable_name = "mag_field_y_bg" + field_types(9)%field_name = "y Component of Background Magnetic Field" + + call field_types(10)%init() + field_types(10)%field_to_cgs = 10000.0 + field_types(10)%staggering = 0 + field_types(10)%field_units = "T" + field_types(10)%variable_name = "mag_field_y_pert" + field_types(10)%field_name = "y Component of Pertubation Magnetic Field" + + end subroutine sacgdf_make_field_types_2D + + subroutine sacgdf_make_field_types_3D(field_types) + + use gdf, only: gdf_field_type_T + use common_variables, only: nw + implicit none + + type(gdf_field_type_T), dimension(13), intent(inout) :: field_types + + call sacgdf_make_field_types_2D(field_types(1:10)) + + call field_types(11)%init() + field_types(11)%field_to_cgs = 10000.0 + field_types(11)%staggering = 0 + field_types(11)%field_units = "T" + field_types(11)%variable_name = "mag_field_z_pert" + field_types(11)%field_name = "z Component of Pertubation Magnetic Field" + + call field_types(12)%init() + field_types(12)%field_to_cgs = 10000.0 + field_types(12)%staggering = 0 + field_types(12)%field_units = "T" + field_types(12)%variable_name = "mag_field_z_bg" + field_types(12)%field_name = "z Component of Background Magnetic Field" + + call field_types(13)%init() + field_types(13)%field_to_cgs = 100 + field_types(13)%staggering = 0 + field_types(13)%field_units = "ms^{-1}" + field_types(13)%variable_name = "velocity_z" + field_types(13)%field_name = "z Component of Velocity" + + end subroutine sacgdf_make_field_types_3D + +!!$ subroutine sacgdf_read_eqpar(file_id, dimensionality) +!!$ ! Convert simulation parameters to the eqpar array +!!$ use common_variables +!!$ use hdf5, only: HID_T, h5gopen_f, h5gclose_f +!!$ use helpers_hdf5, only: read_attribute +!!$ +!!$ implicit none +!!$ +!!$ integer(HID_T), intent(in) :: file_id +!!$ integer, intent(in) :: dimensionality +!!$ +!!$ integer(HID_T) :: g_id +!!$ integer :: error +!!$ +!!$ +!!$ call h5gopen_f(file_id, 'simulation_parameters', g_id, error) +!!$ call read_attribute(g_id, 'gamma', eqpar(gamma_)) +!!$ call read_attribute(g_id, 'eta', eqpar(eta_)) +!!$ call read_attribute(g_id, 'gravity0', eqpar(grav0_)) +!!$ call read_attribute(g_id, 'gravity1', eqpar(grav1_)) +!!$ ! Read the extra parameters only if we are 2D or 3D +!!$ {^IFTWOD +!!$ call read_attribute(g_id, 'gravity2', eqpar(grav2_)) +!!$ } +!!$ {^IFTHREED +!!$ call read_attribute(g_id, 'gravity3', eqpar(grav3_)) +!!$ } +!!$ call read_attribute(g_id, 'nu', eqpar(nu_)) +!!$ call h5close_f(g_id, error) +!!$ +!!$ end subroutine sacgdf_read_eqpar end module sacgdf diff --git a/sac/src/vac.t b/sac/src/vac.t index 46d2f19..bb8d55e 100644 --- a/sac/src/vac.t +++ b/sac/src/vac.t @@ -14,11 +14,11 @@ PROGRAM vac USE common_variables INTEGER:: ifile,ierrcode,iw - DOUBLE PRECISION:: w(ixG^T,nw),wnrm2,dtold,time0,time1 + REAL(kind=8):: w(ixG^T,nw),wnrm2,dtold,time0,time1 ! functions LOGICAL:: timetofinish,timetosave - DOUBLE PRECISION:: cputime + REAL(kind=8):: cputime !----------------------------------------------------------------------------- {CALL mpiinit ^IFMPI} @@ -238,7 +238,7 @@ SUBROUTINE advance(iws,w) USE common_variables INTEGER:: iws(niw_) - DOUBLE PRECISION:: w(ixG^T,nw), w1(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw), w1(ixG^T,nw) !----------------------------------------------------------------------------- ! Add split sources berforehand if this is required @@ -303,7 +303,7 @@ SUBROUTINE advance_expl(method,ix^L,iws,w1,w) CHARACTER(^LENTYPE) :: method INTEGER :: ix^L,iws(niw_) - DOUBLE PRECISION :: w(ixG^T,nw),w1(ixG^T,nw) + REAL(kind=8) :: w(ixG^T,nw),w1(ixG^T,nw) LOGICAL :: firstsweep,lastsweep !----------------------------------------------------------------------------- @@ -381,12 +381,12 @@ SUBROUTINE advect(method,ix^L,iws,idim^LIM,w1,w,firstsweep,lastsweep) CHARACTER(^LENTYPE):: method INTEGER:: ix^L,iws(niw_),idim^LIM - DOUBLE PRECISION:: w1(ixG^T,nw),w(ixG^T,nw) + REAL(kind=8):: w1(ixG^T,nw),w(ixG^T,nw) ! For most Runge-Kutta type schemes one more full array is needed ! For classical RK4 another array is needed {^ANDIFRK - DOUBLE PRECISION:: w2(ixG^T,nw),w3(ixG^T,nw) + REAL(kind=8):: w2(ixG^T,nw),w3(ixG^T,nw) } !!!MEMORY Needed for typeadvance='adams2' only @@ -506,7 +506,7 @@ SUBROUTINE advect1(method,qdt,ixI^L,iws,idim^LIM,qtC,wCT,qt,w,firstsweep,lastswe CHARACTER(^LENTYPE) :: method INTEGER:: ixI^L,ixO^L,iws(niw_),idim^LIM,idim - DOUBLE PRECISION:: qdt,qtC,qt,wCT(ixG^T,nw),w(ixG^T,nw) + REAL(kind=8):: qdt,qtC,qt,wCT(ixG^T,nw),w(ixG^T,nw) LOGICAL, INTENT(INOUT) :: firstsweep,lastsweep !----------------------------------------------------------------------------- @@ -565,7 +565,7 @@ SUBROUTINE addsource2(qdt,ixII^L,ixOO^L,iws,qtC,wCT,qt,w) USE common_variables INTEGER:: ixI^L,ixO^L,ixII^L,ixOO^L,iws(niw_) - DOUBLE PRECISION:: qdt,qtC,qt,wCT(ixG^T,nw),w(ixG^T,nw) + REAL(kind=8):: qdt,qtC,qt,wCT(ixG^T,nw),w(ixG^T,nw) !----------------------------------------------------------------------------- oktest=INDEX(teststr,'addsource')>=1 @@ -599,7 +599,7 @@ LOGICAL FUNCTION timetofinish(time0) USE constants USE common_variables - DOUBLE PRECISION:: time0, cputime + REAL(kind=8):: time0, cputime LOGICAL:: okfinish !----------------------------------------------------------------------------- @@ -663,7 +663,7 @@ SUBROUTINE getdt_courant(w,ix^L) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw),cmax(ixG^T),courantmax,dtold + REAL(kind=8):: w(ixG^T,nw),cmax(ixG^T),courantmax,dtold INTEGER:: ix^L,idim LOGICAL:: new_cmax !----------------------------------------------------------------------------- @@ -711,7 +711,7 @@ SUBROUTINE getdt_courant(w,ix^L) END SUBROUTINE getdt_courant !============================================================================= -DOUBLE PRECISION FUNCTION cputime() +REAL(kind=8) FUNCTION cputime() ! Return cputime in seconds as a double precision number. ! For g77 compiler replace F77_ with F77_ everywhere in this function diff --git a/sac/src/vaccd.t b/sac/src/vaccd.t index 71d87a7..252269c 100644 --- a/sac/src/vaccd.t +++ b/sac/src/vaccd.t @@ -15,11 +15,11 @@ SUBROUTINE centdiff4(qdt,ixI^L,ixO^L,iws,idim^LIM,qtC,wCT,qt,w) USE constants USE common_variables - DOUBLE PRECISION:: qdt,qtC,qt,wCT(ixG^T,nw),w(ixG^T,nw) + REAL(kind=8):: qdt,qtC,qt,wCT(ixG^T,nw),w(ixG^T,nw) INTEGER:: ixI^L,ixO^L,iws(niw_),idim^LIM LOGICAL :: transport - DOUBLE PRECISION:: v(ixG^T),f(ixG^T), fb(ixG^T) + REAL(kind=8):: v(ixG^T),f(ixG^T), fb(ixG^T) INTEGER:: iiw,iw,ix^L,idim,idir !----------------------------------------------------------------------------- diff --git a/sac/src/vacdef.t b/sac/src/vacdef.t index ecee484..d8d21a3 100644 --- a/sac/src/vacdef.t +++ b/sac/src/vacdef.t @@ -3,9 +3,9 @@ MODULE phys_constants SAVE INTEGER, PARAMETER :: biginteger=10000000 - DOUBLE PRECISION, PARAMETER :: pi= 3.1415926535897932384626433832795 - DOUBLE PRECISION, PARAMETER :: smalldouble=1.d-99, bigdouble=1.d+99 - DOUBLE PRECISION, PARAMETER :: zero=0d0, one=1d0, two=2d0, half=0.5d0, quarter=0.25d0 + REAL(kind=8), PARAMETER :: pi= 3.1415926535897932384626433832795 + REAL(kind=8), PARAMETER :: smalldouble=1.d-99, bigdouble=1.d+99 + REAL(kind=8), PARAMETER :: zero=0d0, one=1d0, two=2d0, half=0.5d0, quarter=0.25d0 END MODULE phys_constants @@ -97,8 +97,8 @@ module common_variables INTEGER:: ipe, ipe^D, npe, npe^D, nxall^D, nxpe^D, ierrmpi INTEGER:: ixPEmin^D, ixPEmax^D LOGICAL:: mpiupperB(ndim),mpilowerB(ndim) - DOUBLE PRECISION:: sendbuffer(nmpibuffer) - DOUBLE PRECISION:: recvbuffer(nmpibuffer,2) + REAL(kind=8):: sendbuffer(nmpibuffer) + REAL(kind=8):: recvbuffer(nmpibuffer,2) } ! Unit for reading input parameters. @@ -109,7 +109,7 @@ module common_variables ! General temporary arrays, any subroutine call may change them ! except for subroutines which say the opposite in their header - DOUBLE PRECISION:: tmp(ixG^T),tmp2(ixG^T) + REAL(kind=8):: tmp(ixG^T),tmp2(ixG^T) ! Number of errors during calculation INTEGER:: nerror(nerrcode) @@ -121,35 +121,35 @@ module common_variables INTEGER:: ixM^L,ixG^L,nx^D,nx(ndim) INTEGER:: dixB^L ! x and dx are local for HPF - DOUBLE PRECISION:: x(IXG^T,ndim),dx(IXG^T,ndim) - DOUBLE PRECISION:: volume,dvolume(IXG^T) - DOUBLE PRECISION:: area(IXGLO1:IXGHI1),areaC(IXGLO1:IXGHI1) - DOUBLE PRECISION:: areadx(IXGLO1:IXGHI1),areaside(IXGLO1:IXGHI1) + REAL(kind=8):: x(IXG^T,ndim),dx(IXG^T,ndim) + REAL(kind=8):: volume,dvolume(IXG^T) + REAL(kind=8):: area(IXGLO1:IXGHI1),areaC(IXGLO1:IXGHI1) + REAL(kind=8):: areadx(IXGLO1:IXGHI1),areaside(IXGLO1:IXGHI1) ! Variables for generalized coordinates and polargrid LOGICAL:: gencoord, polargrid - {^IFGEN DOUBLE PRECISION:: surfaceC(IXG^T,ndim),normalC(IXG^T,ndim,ndim)} - {^NOGEN DOUBLE PRECISION:: surfaceC(2^D&,ndim), normalC(2^D&,ndim,ndim)} + {^IFGEN REAL(kind=8):: surfaceC(IXG^T,ndim),normalC(IXG^T,ndim,ndim)} + {^NOGEN REAL(kind=8):: surfaceC(2^D&,ndim), normalC(2^D&,ndim,ndim)} !Boundary region parameters - DOUBLE PRECISION:: fixB^D(-dixBlo:dixBhi^D%ixGLO^DD:ixGHI^DD,nw) + REAL(kind=8):: fixB^D(-dixBlo:dixBhi^D%ixGLO^DD:ixGHI^DD,nw) INTEGER:: nB,ixB^LIM(ndim,nhiB),idimB(nhiB),ipairB(nhiB) LOGICAL:: upperB(nhiB),fixedB(nw,nhiB),nofluxB(nw,ndim),extraB CHARACTER(^LENTYPE) :: typeB(nw,nhiB),typeBscalar(nhiB) !Equation and method parameters - DOUBLE PRECISION:: eqpar(neqpar+nspecialpar),procpar(nprocpar) + real(kind=8), target :: eqpar(neqpar+nspecialpar),procpar(nprocpar) ! Time step control parameters - DOUBLE PRECISION:: courantpar,dtpar,dtdiffpar,dtcourant(ndim),dtmrpc + REAL(kind=8):: courantpar,dtpar,dtdiffpar,dtcourant(ndim),dtmrpc LOGICAL:: dtcantgrow INTEGER:: slowsteps ! Parameters for the implicit techniques - {^IFPOISSON DOUBLE PRECISION:: wrk(ixG^T,nwrk) } - {^IFIMPL DOUBLE PRECISION:: work(nwork) } + {^IFPOISSON REAL(kind=8):: wrk(ixG^T,nwrk) } + {^IFIMPL REAL(kind=8):: work(nwork) } INTEGER:: nwimpl,nimpl - DOUBLE PRECISION:: implpar,impldiffpar,implerror,implrelax,impldwlimit + REAL(kind=8):: implpar,impldiffpar,implerror,implrelax,impldwlimit INTEGER:: implrestart,implrestart2,impliter,impliternr,implmrpcpar CHARACTER(^LENTYPE) :: typeimplinit,typeimpliter,typeimplmat LOGICAL:: implconserv,implnewton,implcentered,implnewmat @@ -168,23 +168,23 @@ module common_variables LOGICAL:: divbfix,divbwave,divbconstrain,angmomfix,compactres,smallfix INTEGER:: idimsplit INTEGER:: nproc(nfile+2) - DOUBLE PRECISION:: entropycoef(nw),constraincoef - DOUBLE PRECISION:: smallp,smallpcoeff,smallrho,smallrhocoeff,vacuumrho - DOUBLE PRECISION:: muscleta1,muscleta2,musclomega,acmcoef(nw),acmexpo + REAL(kind=8):: entropycoef(nw),constraincoef + REAL(kind=8):: smallp,smallpcoeff,smallrho,smallrhocoeff,vacuumrho + REAL(kind=8):: muscleta1,muscleta2,musclomega,acmcoef(nw),acmexpo LOGICAL:: acmnolim, fourthorder INTEGER:: acmwidth !Previous time step and residuals - DOUBLE PRECISION:: wold(ixG^T,nw),residual,residmin,residmax + REAL(kind=8):: wold(ixG^T,nw),residual,residmin,residmax ! Flux storage for flux-CT and flux-CD methods !!! for MHD only !!! - {^IFCT DOUBLE PRECISION:: fstore(ixG^T,ndim) } + {^IFCT REAL(kind=8):: fstore(ixG^T,ndim) } !Time parameters INTEGER:: step,istep,nstep,it,itmin,itmax,nexpl,nnewton,niter,nmatvec - DOUBLE PRECISION:: t,tmax,dt,dtmin,cputimemax + REAL(kind=8):: t,tmax,dt,dtmin,cputimemax LOGICAL:: tmaxexact - DOUBLE PRECISION:: tsave(nsavehi,nfile),tsavelast(nfile),dtsave(nfile) + REAL(kind=8):: tsave(nsavehi,nfile),tsavelast(nfile),dtsave(nfile) INTEGER:: itsave(nsavehi,nfile),itsavelast(nfile),ditsave(nfile) INTEGER:: isavet(nfile),isaveit(nfile) @@ -200,6 +200,6 @@ module common_variables INTEGER:: ixtest1,ixtest2,ixtest3,iwtest,idimtest,ipetest^IFMPI LOGICAL:: oktest !This is a local variable for all subroutines and functions - DOUBLE PRECISION:: maxviscoef + REAL(kind=8):: maxviscoef end module common_variables diff --git a/sac/src/vacgrid.t b/sac/src/vacgrid.t index a7db05f..9746a10 100644 --- a/sac/src/vacgrid.t +++ b/sac/src/vacgrid.t @@ -171,7 +171,7 @@ SUBROUTINE ensurebound(dix,ixI^L,ixO^L,qt,w) USE common_variables INTEGER:: dix,ixI^L,ixO^L - DOUBLE PRECISION:: qt,w(ixG^T,nw) + REAL(kind=8):: qt,w(ixG^T,nw) !----------------------------------------------------------------------------- oktest=INDEX(teststr,'ensurebound')>0 @@ -200,10 +200,10 @@ SUBROUTINE getboundary(qt,iw^LIM,idim^LIM,w) USE common_variables INTEGER:: iw^LIM,idim^LIM - DOUBLE PRECISION:: qt,w(ixG^T,1:nw) + REAL(kind=8):: qt,w(ixG^T,1:nw) INTEGER:: ix,ix^D,ixe,ixf,ix^L,ixpair^L,idim,iw,iB INTEGER:: iwv,jdim - DOUBLE PRECISION:: coeffnormal,coefftransv + REAL(kind=8):: coeffnormal,coefftransv LOGICAL:: initialized @@ -525,7 +525,7 @@ SUBROUTINE setnoflux(iw,idim,ix^L,fRC,ixR^L,fLC,ixL^L) USE common_variables INTEGER:: iw,idim,ix^L,ixL^L,ixR^L - DOUBLE PRECISION:: fRC(ixG^T), fLC(ixG^T) + REAL(kind=8):: fRC(ixG^T), fLC(ixG^T) INTEGER:: iB,ixe,ixB^L !----------------------------------------------------------------------------- @@ -573,8 +573,8 @@ SUBROUTINE gridsetup1 INTEGER:: ix^L,hx^L,jx^L INTEGER:: ix,ixe,ixf,idim,jdim - DOUBLE PRECISION:: qx(IXG^LL^LADD1:,ndim) - DOUBLE PRECISION:: r(IXGLO1-1:IXGHI1+1),rC(IXGLO1-1:IXGHI1+1) + REAL(kind=8):: qx(IXG^LL^LADD1:,ndim) + REAL(kind=8):: r(IXGLO1-1:IXGHI1+1),rC(IXGLO1-1:IXGHI1+1) !----------------------------------------------------------------------------- @@ -675,7 +675,7 @@ SUBROUTINE gradient4(realgrad,q,ix^L,idim,gradq) LOGICAL:: realgrad INTEGER:: ix^L,idim - DOUBLE PRECISION:: q(ixG^T),gradq(ixG^T) + REAL(kind=8):: q(ixG^T),gradq(ixG^T) INTEGER:: kx^L,jx^L,hx^L,gx^L INTEGER:: minx1^D,maxx1^D,k !----------------------------------------------------------------------------- @@ -734,7 +734,7 @@ SUBROUTINE laplace4(q,ix^L,laplaceq) USE common_variables INTEGER:: ix^L - DOUBLE PRECISION:: q(ixG^T),laplaceq(ixG^T) + REAL(kind=8):: q(ixG^T),laplaceq(ixG^T) INTEGER:: idim,kx^L,jx^L,hx^L,gx^L !----------------------------------------------------------------------------- diff --git a/sac/src/vacio.t b/sac/src/vacio.t index 7c13585..ee3d044 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -12,10 +12,10 @@ SUBROUTINE readparameters(w) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) CHARACTER(^LENTYPE):: typepred(nw),typefull(nw),typeimpl(nw),typefilter(nw) - DOUBLE PRECISION:: muscleta + REAL(kind=8):: muscleta INTEGER:: i,j,k,iw,idim,iB,ifile,isave LOGICAL:: implmrpc,globalixtest^IFMPI @@ -544,7 +544,7 @@ SUBROUTINE readfileini(w) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) LOGICAL:: fileexist CHARACTER(91):: fhead @@ -617,13 +617,13 @@ SUBROUTINE readfileini_asc(w) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) LOGICAL:: fileexist INTEGER:: ios ! 0 if not EOF, -1 if EOF, >0 if error INTEGER:: ndimini,neqparini,neqparin,nwini,nwin ! values describing input data INTEGER:: ix^L,ix^D,idim,iw,ieqpar,snapshot - DOUBLE PRECISION:: eqparextra,wextra + REAL(kind=8):: eqparextra,wextra CHARACTER(^LENNAME) :: varnamesini !----------------------------------------------------------------------------- @@ -693,13 +693,13 @@ SUBROUTINE readfileini_bin(w) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) LOGICAL:: fileexist INTEGER:: ios ! 0 if not EOF, -1 if EOF, >0 if error INTEGER:: ndimini,neqparini,neqparin,nwini,nwin ! values describing input data INTEGER:: ix^L,idim,iw,ieqpar,snapshot - DOUBLE PRECISION:: eqparextra + REAL(kind=8):: eqparextra CHARACTER(^LENNAME) :: varnamesini !----------------------------------------------------------------------------- @@ -930,7 +930,7 @@ SUBROUTINE savefile(ifile,w) USE common_variables INTEGER:: ifile,ix^L - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) CHARACTER(10):: itstring !----------------------------------------------------------------------------- @@ -965,6 +965,8 @@ SUBROUTINE savefile(ifile,w) CALL savefileout_asc(unitini+ifile,w,ix^L) CASE('binary') CALL savefileout_bin(unitini+ifile,w,ix^L) + CASE('gdf') + call savefileout_gdf(w,ix^L) CASE default CALL die('Error in SaveFile: Unknown typefileout:'//typefileout) END SELECT @@ -994,7 +996,7 @@ SUBROUTINE savefileout_asc(qunit,w,ix^L) USE common_variables INTEGER:: qunit,ix^L,ix^D,iw,idim,ndimout - DOUBLE PRECISION:: w(ixG^T,nw),qw(nw) + REAL(kind=8):: w(ixG^T,nw),qw(nw) LOGICAL:: fileopen !----------------------------------------------------------------------------- @@ -1039,7 +1041,7 @@ SUBROUTINE savefileout_bin(qunit,w,ix^L) USE common_variables INTEGER:: qunit,ix^L,idim,iw,ndimout - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) LOGICAL:: fileopen !**************** slice @@ -1113,6 +1115,91 @@ SUBROUTINE savefileout_bin(qunit,w,ix^L) RETURN END SUBROUTINE savefileout_bin +!============================================================================= + + +SUBROUTINE savefileout_gdf(w,ix^L) + + USE hdf5 + use gdf + use sacgdf + use gdf_datasets + USE common_variables + + IMPLICIT NONE + + INTEGER, INTENT(IN) :: ix^L + REAL(kind=8), INTENT(IN):: w(ixG^T,nw) + + INTEGER(HID_T) :: file_id + integer(HID_T) :: plist_id !< Property list identifier + integer(HID_T) :: doml_g_id !< domain list identifier + integer(HID_T) :: dom_g_id !< domain group identifier + INTEGER :: error + + character(len=8) :: itstr + + type(gdf_root_datasets_T) :: rd + type(gdf_parameters_T) :: gdf_sp + type(gdf_field_type_T), dimension(nw) :: field_types + + class(*), dimension(:^D&), pointer :: d_ptr + real(kind=8), dimension(ix^S), target :: wdata + + ! Open file + CALL h5open_f(error) + ! Create a property access list (for MPI later on) + call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, error) + ! Create the file + ! Convert the current iteration to a string + write(itstr, '(I8.8)') it + call h5fcreate_f(TRIM(filenameout)//itstr//'.gdf', H5F_ACC_TRUNC_F, file_id, error, access_prp=plist_id) + + ! Create + ! Simulation Parameters + call gdf_sp%init(^ND) + gdf_sp%boundary_conditions = (/ 2, 2, 2, 2, 2, 2 /) + gdf_sp%cosmological_simulation = 0 + gdf_sp%current_time = t + gdf_sp%dimensionality = ^ND + gdf_sp%domain_dimensions = nx ! on disk + gdf_sp%domain_left_edge = x(ixmin^D, :) !bottom left corner + gdf_sp%domain_right_edge = x(ixmax^D, :) ! top right corner + gdf_sp%field_ordering = 1 + gdf_sp%num_ghost_zones = 0 !on disk + gdf_sp%refine_by = 0 + gdf_sp%unique_identifier = "sacgdf2014" + + ! Initilize the data + call rd%init(^ND, 1) + + rd%grid_parent_id = 0 + rd%grid_left_index(:, 1) = (/ 0, 0 /) + rd%grid_dimensions(:, 1) = nx + rd%grid_level = 0 + rd%grid_particle_count(:, 1) = (/ 0 /) + + call sacgdf_make_field_types(field_types) + + call sacgdf_write_file(file_id, rd, gdf_sp, field_types) + + ! Now write the datasets + ! Create field groups + call h5gcreate_f(file_id, "data", dom_g_id, error) !Create /data + call h5gcreate_f(dom_g_id, "grid_0000000000", doml_g_id, error) !Create the top grid + + ! WRITE ACTUAL DATA HERE + + wdata(ix^S) = w(ix^S, m1_) / (w(ix^S, rho_) + w(ix^S, rhob_)) + d_ptr => wdata + call write_dataset(doml_g_id, 'velocity_x', d_ptr, plist_id) + + + CALL h5fclose_f(file_id, error) + CALL h5close_f(error) + +END SUBROUTINE savefileout_gdf + !============================================================================= SUBROUTINE savefilelog_default(qunit,w,ix^L) @@ -1132,10 +1219,10 @@ SUBROUTINE savefilelog_default(qunit,w,ix^L) USE common_variables INTEGER:: qunit,ix^L - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) INTEGER:: iw LOGICAL:: fileopen - DOUBLE PRECISION:: wmean(nw) + REAL(kind=8):: wmean(nw) !----------------------------------------------------------------------------- IF(ipe==0)THEN^IFMPI diff --git a/sac/src/vacmpi.t b/sac/src/vacmpi.t index 52b8e8e..9a779db 100644 --- a/sac/src/vacmpi.t +++ b/sac/src/vacmpi.t @@ -204,7 +204,7 @@ SUBROUTINE mpireduce(a,mpifunc) USE constants - DOUBLE PRECISION :: a, alocal + REAL(kind=8) :: a, alocal INTEGER :: mpifunc, ierrmpi !---------------------------------------------------------------------------- alocal = a @@ -221,7 +221,7 @@ SUBROUTINE mpiallreduce(a,mpifunc) USE constants - DOUBLE PRECISION :: a, alocal + REAL(kind=8) :: a, alocal INTEGER :: mpifunc, ierrmpi !----------------------------------------------------------------------------- alocal = a @@ -307,7 +307,7 @@ SUBROUTINE mpibound(nvar,var) USE common_variables INTEGER :: nvar - DOUBLE PRECISION :: var(ixG^T,nvar) + REAL(kind=8) :: var(ixG^T,nvar) ! processor indexes for left and right neighbors INTEGER :: hpe,jpe @@ -385,7 +385,7 @@ SUBROUTINE mpisend(nvar,var,ix^L,qipe,iside) USE common_variables INTEGER :: nvar - DOUBLE PRECISION :: var(ixG^T,nvar) + REAL(kind=8) :: var(ixG^T,nvar) INTEGER :: ix^L, qipe, iside, n, ix^D, ivar !---------------------------------------------------------------------------- oktest = INDEX(teststr,'mpisend')>0 @@ -447,7 +447,7 @@ SUBROUTINE mpibuffer2var(iside,nvar,var,ix^L) USE common_variables INTEGER :: nvar - DOUBLE PRECISION:: var(ixG^T,nvar) + REAL(kind=8):: var(ixG^T,nvar) INTEGER:: ix^L,iside,n,ix^D,ivar !----------------------------------------------------------------------------- oktest = INDEX(teststr,'buffer2var')>0 diff --git a/sac/src/vacphys.mhd0.t b/sac/src/vacphys.mhd0.t index deac38f..1cc5e27 100644 --- a/sac/src/vacphys.mhd0.t +++ b/sac/src/vacphys.mhd0.t @@ -44,10 +44,10 @@ SUBROUTINE process(count,idim^LIM,w) USE common_variables INTEGER:: count,idim^LIM - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) LOGICAL:: oktime - DOUBLE PRECISION:: cputime,time1,timeproc + REAL(kind=8):: cputime,time1,timeproc DATA timeproc /0.D0/ ! The processing should eliminate divergence of B. @@ -90,7 +90,7 @@ SUBROUTINE getdt(w,ix^L) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) INTEGER:: ix^L !----------------------------------------------------------------------------- @@ -115,7 +115,7 @@ SUBROUTINE getdivb(w,ixO^L,divb) USE common_variables INTEGER:: ixO^L,ix^L,idim - DOUBLE PRECISION:: w(ixG^T,nw),divb(ixG^T) + REAL(kind=8):: w(ixG^T,nw),divb(ixG^T) !----------------------------------------------------------------------------- oktest=INDEX(teststr,'getdivb')>=1 @@ -158,7 +158,7 @@ SUBROUTINE getflux(w,ix^L,iw,idim,f,transport) USE common_variables INTEGER:: ix^L,iw,idim - DOUBLE PRECISION:: w(ixG^T,nw),f(ixG^T), fb(ixG^T) + REAL(kind=8):: w(ixG^T,nw),f(ixG^T), fb(ixG^T) LOGICAL:: transport !----------------------------------------------------------------------------- @@ -239,7 +239,7 @@ SUBROUTINE addsource(qdt,ixI^L,ixO^L,iws,qtC,w,qt,wnew) USE common_variables INTEGER:: ixI^L,ixO^L,iws(niw_) - DOUBLE PRECISION:: qdt,qtC,qt,w(ixG^T,nw),wnew(ixG^T,nw) + REAL(kind=8):: qdt,qtC,qt,w(ixG^T,nw),wnew(ixG^T,nw) !----------------------------------------------------------------------------- oktest=INDEX(teststr,'addsource')>=1 @@ -279,8 +279,8 @@ SUBROUTINE addsource_divb(qdt,ixI^L,ixO^L,iws,qtC,w,qt,wnew) USE common_variables INTEGER:: ixI^L,ixO^L,iws(niw_),iiw,iw - DOUBLE PRECISION:: qdt,qtC,qt,w(ixG^T,nw),wnew(ixG^T,nw) - DOUBLE PRECISION:: divb(ixG^T) + REAL(kind=8):: qdt,qtC,qt,w(ixG^T,nw),wnew(ixG^T,nw) + REAL(kind=8):: divb(ixG^T) !----------------------------------------------------------------------------- ! Calculating div B involves first derivatives diff --git a/sac/src/vacphys.t.mhd b/sac/src/vacphys.t.mhd index 0244a13..3d867fd 100644 --- a/sac/src/vacphys.t.mhd +++ b/sac/src/vacphys.t.mhd @@ -13,7 +13,7 @@ SUBROUTINE keeppositive(ix^L,w) USE common_variables INTEGER:: ix^L - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) LOGICAL:: toosmallp !----------------------------------------------------------------------------- diff --git a/sac/src/vacphys0.t.mhd b/sac/src/vacphys0.t.mhd index d5c3597..5a48ac4 100644 --- a/sac/src/vacphys0.t.mhd +++ b/sac/src/vacphys0.t.mhd @@ -10,7 +10,7 @@ SUBROUTINE conserve(ix^L,w) USE common_variables INTEGER:: ix^L - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) !----------------------------------------------------------------------------- @@ -37,7 +37,7 @@ SUBROUTINE primitive(ix^L,w) USE common_variables INTEGER:: ix^L - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) !----------------------------------------------------------------------------- @@ -62,7 +62,7 @@ SUBROUTINE getv(w,ix^L,idim,v) USE common_variables INTEGER:: ix^L,idim - DOUBLE PRECISION:: w(ixG^T,nw),v(ixG^T) + REAL(kind=8):: w(ixG^T,nw),v(ixG^T) !----------------------------------------------------------------------------- oktest=INDEX(teststr,'getv')>=1 @@ -89,8 +89,8 @@ SUBROUTINE getcmax(new_cmax,w,ix^L,idim,cmax) LOGICAL:: new_cmax INTEGER:: ix^L,idim - DOUBLE PRECISION:: w(ixG^T,nw),cmax(ixG^T) - DOUBLE PRECISION:: csound2(ixG^T),cfast2(ixG^T) + REAL(kind=8):: w(ixG^T,nw),cmax(ixG^T) + REAL(kind=8):: csound2(ixG^T),cfast2(ixG^T) SAVE csound2,cfast2 !----------------------------------------------------------------------------- oktest=INDEX(teststr,'getcmax')>=1 @@ -125,7 +125,7 @@ SUBROUTINE getcsound2prim(w,ix^L,csound2) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw),csound2(ixG^T) + REAL(kind=8):: w(ixG^T,nw),csound2(ixG^T) INTEGER:: ix^L !----------------------------------------------------------------------------- @@ -147,7 +147,7 @@ SUBROUTINE getcsound2(w,ix^L,csound2) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw),csound2(ixG^T) + REAL(kind=8):: w(ixG^T,nw),csound2(ixG^T) INTEGER:: ix^L !----------------------------------------------------------------------------- @@ -174,7 +174,7 @@ SUBROUTINE getpthermal(w,ix^L,p) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw),p(ixG^T) + REAL(kind=8):: w(ixG^T,nw),p(ixG^T) INTEGER:: ix^L !----------------------------------------------------------------------------- @@ -195,7 +195,7 @@ SUBROUTINE getptotal(w,ix^L,p) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw),p(ixG^T),gamma + REAL(kind=8):: w(ixG^T,nw),p(ixG^T),gamma INTEGER:: ix^L !----------------------------------------------------------------------------- @@ -218,7 +218,7 @@ SUBROUTINE getptotal_bg(w,ix^L,p) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw),p(ixG^T),gamma + REAL(kind=8):: w(ixG^T,nw),p(ixG^T),gamma INTEGER:: ix^L !----------------------------------------------------------------------------- diff --git a/sac/src/vacusr.gravity.t b/sac/src/vacusr.gravity.t index 55c4a0b..47768dc 100644 --- a/sac/src/vacusr.gravity.t +++ b/sac/src/vacusr.gravity.t @@ -30,7 +30,7 @@ SUBROUTINE addsource_grav(qdt,ixI^L,ixO^L,iws,qtC,w,qt,wnew) USE common_variables INTEGER:: ixI^L,ixO^L,iws(niw_) - DOUBLE PRECISION:: qdt,qtC,qt,w(ixG^T,nw),wnew(ixG^T,nw) + REAL(kind=8):: qdt,qtC,qt,w(ixG^T,nw),wnew(ixG^T,nw) INTEGER:: iiw,iw,idim !!! ! For a spatially varying gravity define the common grav array !!! double precision:: grav(ixG^T,ndim) @@ -100,9 +100,9 @@ SUBROUTINE getdt_grav(w,ix^L) USE constants USE common_variables - DOUBLE PRECISION :: w(ixG^T,nw) + REAL(kind=8) :: w(ixG^T,nw) INTEGER :: ix^L,idim - DOUBLE PRECISION, SAVE :: dtgrav + REAL(kind=8), SAVE :: dtgrav !!! ! For spatially varying gravity you need a common grav array !!! double precision:: grav(ixG^T,ndim) diff --git a/sac/src/vacusr.t.default b/sac/src/vacusr.t.default index ade5144..3ed077f 100644 --- a/sac/src/vacusr.t.default +++ b/sac/src/vacusr.t.default @@ -15,7 +15,7 @@ SUBROUTINE specialini(ix^L,w) USE common_variables INTEGER:: ix^L - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) !----------------------------------------------------------------------------- CALL die('Special initial condition is not defined') @@ -31,7 +31,7 @@ SUBROUTINE specialbound(qt,ix^L,iw,iB,w) USE common_variables INTEGER:: ix^L,iw,iB - DOUBLE PRECISION:: qt,w(ixG^T,nw) + REAL(kind=8):: qt,w(ixG^T,nw) !----------------------------------------------------------------------------- CALL die('Special boundary is not defined') @@ -62,7 +62,7 @@ SUBROUTINE specialsource(qdt,ixI^L,ixO^L,iws,qtC,wCT,qt,w) USE common_variables INTEGER:: ixI^L,ixO^L,iws(niw_) - DOUBLE PRECISION:: qdt,qtC,qt,wCT(ixG^T,nw),w(ixG^T,nw) + REAL(kind=8):: qdt,qtC,qt,wCT(ixG^T,nw),w(ixG^T,nw) !This is some hyperdiffusion stabilisaton... IF(ABS(eqpar(nu_))>smalldouble)& @@ -81,7 +81,7 @@ SUBROUTINE getdt_special(w,ix^L) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) INTEGER:: ix^L !----------------------------------------------------------------------------- @@ -105,7 +105,7 @@ SUBROUTINE specialeta(w,ix^L,idirmin) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) INTEGER:: ix^L,idirmin CALL die('specialeta is not defined') @@ -121,7 +121,7 @@ SUBROUTINE readfileini_special(w) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) !----------------------------------------------------------------------------- CALL die('Special readfileini is not defined') @@ -136,7 +136,7 @@ SUBROUTINE savefileout_special(qunit,w,ix^L) USE common_variables INTEGER:: qunit,ix^L - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) !----------------------------------------------------------------------------- CALL die('Special savefileout is not defined') @@ -151,7 +151,7 @@ SUBROUTINE savefilelog_special(qunit,w,ix^L) USE common_variables INTEGER:: qunit,ix^L - DOUBLE PRECISION:: w(ixG^T,nw) + REAL(kind=8):: w(ixG^T,nw) !----------------------------------------------------------------------------- CALL die('Special savefilelog is not defined') diff --git a/sac/src/vacusr.viscosity.t b/sac/src/vacusr.viscosity.t index e0bfe99..37c80cd 100644 --- a/sac/src/vacusr.viscosity.t +++ b/sac/src/vacusr.viscosity.t @@ -7,31 +7,31 @@ SUBROUTINE addsource_visc(qdt,ixI^L,ixO^L,iws,qtC,w,qt,wnew) USE common_variables INTEGER:: ixI^L,ixO^L,iws(niw_) - DOUBLE PRECISION:: qdt,qtC,qt,w(ixG^T,nw),wnew(ixG^T,nw) + REAL(kind=8):: qdt,qtC,qt,w(ixG^T,nw),wnew(ixG^T,nw) INTEGER:: ix,ix^L,idim,idir,jdir,iiw,iw !already declared in vacusr.f !double precision:: tmp2(ixG^T) - DOUBLE PRECISION:: nushk(ixG^T,ndim) + REAL(kind=8):: nushk(ixG^T,ndim) - DOUBLE PRECISION:: tmprhoL(ixG^T), tmprhoR(ixG^T), tmprhoC(ixG^T) - DOUBLE PRECISION:: tmpVL(ixG^T), tmpVR(ixG^T), tmpVC(ixG^T) - DOUBLE PRECISION:: tmpBL(ixG^T), tmpBR(ixG^T), tmpBC(ixG^T) + REAL(kind=8):: tmprhoL(ixG^T), tmprhoR(ixG^T), tmprhoC(ixG^T) + REAL(kind=8):: tmpVL(ixG^T), tmpVR(ixG^T), tmpVC(ixG^T) + REAL(kind=8):: tmpBL(ixG^T), tmpBR(ixG^T), tmpBC(ixG^T) - DOUBLE PRECISION:: tmpL(ixG^T),tmpR(ixG^T), tmpC(ixG^T) + REAL(kind=8):: tmpL(ixG^T),tmpR(ixG^T), tmpC(ixG^T) - DOUBLE PRECISION:: nuL(ixG^T),nuR(ixG^T) + REAL(kind=8):: nuL(ixG^T),nuR(ixG^T) INTEGER:: jx^L,hx^L, hxO^L - DOUBLE PRECISION:: c_ene,c_shk + REAL(kind=8):: c_ene,c_shk INTEGER:: i,j,k,l,m,ii0,ii1,t00 - DOUBLE PRECISION:: sB + REAL(kind=8):: sB !----------------------------------------------------------------------------- @@ -230,14 +230,14 @@ SUBROUTINE setnu(w,iw,idim,ix^L,nuR,nuL) USE common_variables INTEGER:: ixi^L - DOUBLE PRECISION:: w(ixG^T,nw) - DOUBLE PRECISION:: d1R(^SIDEADO),d1L(^SIDEADO) - DOUBLE PRECISION:: d3R(^SIDEADO),d3L(^SIDEADO) - DOUBLE PRECISION:: md3R(ixG^T),md3L(ixG^T) - DOUBLE PRECISION:: md1R(ixG^T),md1L(ixG^T) - DOUBLE PRECISION:: nuR(ixG^T),nuL(ixG^T) - - DOUBLE PRECISION:: c_tot, c_hyp,cmax(ixG^T), tmp_nu(ixG^T) + REAL(kind=8):: w(ixG^T,nw) + REAL(kind=8):: d1R(^SIDEADO),d1L(^SIDEADO) + REAL(kind=8):: d3R(^SIDEADO),d3L(^SIDEADO) + REAL(kind=8):: md3R(ixG^T),md3L(ixG^T) + REAL(kind=8):: md1R(ixG^T),md1L(ixG^T) + REAL(kind=8):: nuR(ixG^T),nuL(ixG^T) + + REAL(kind=8):: c_tot, c_hyp,cmax(ixG^T), tmp_nu(ixG^T) INTEGER:: ix^L,idim, iw INTEGER:: kx^L,jx^L,hx^L,gx^L,ixFF^L,jxFF^L,hxFF^L INTEGER:: ix_1,ix_2,ix_3 @@ -246,7 +246,7 @@ SUBROUTINE setnu(w,iw,idim,ix^L,nuR,nuL) LOGICAL:: new_cmax - DOUBLE PRECISION:: tmp_nuI(^SIDEADD) + REAL(kind=8):: tmp_nuI(^SIDEADD) INTEGER:: k,iwc @@ -261,10 +261,10 @@ SUBROUTINE setnu(w,iw,idim,ix^L,nuR,nuL) INTEGER:: hpe,jpe - DOUBLE PRECISION:: tgtbufferR^D(1^D%^LM) - DOUBLE PRECISION:: tgtbufferL^D(1^D%^LM) - DOUBLE PRECISION:: srcbufferR^D(1^D%^LM) - DOUBLE PRECISION:: srcbufferL^D(1^D%^LM) + REAL(kind=8):: tgtbufferR^D(1^D%^LM) + REAL(kind=8):: tgtbufferL^D(1^D%^LM) + REAL(kind=8):: srcbufferR^D(1^D%^LM) + REAL(kind=8):: srcbufferL^D(1^D%^LM) INTEGER:: n @@ -465,11 +465,11 @@ SUBROUTINE setnushk(w,ix^L,nushk) USE common_variables !double precision:: w(ixG^T,nw),tmp2(ixG^T),nushk(ixG^T,ndim) - DOUBLE PRECISION:: w(ixG^T,nw),nushk(ixG^T,ndim) + REAL(kind=8):: w(ixG^T,nw),nushk(ixG^T,ndim) - DOUBLE PRECISION:: c_shk + REAL(kind=8):: c_shk - DOUBLE PRECISION:: tmp3(ixG^T) + REAL(kind=8):: tmp3(ixG^T) INTEGER:: ix^L,idim, iw,i @@ -518,13 +518,13 @@ SUBROUTINE getdt_visc(w,ix^L) USE constants USE common_variables - DOUBLE PRECISION:: w(ixG^T,nw),dtdiff_visc + REAL(kind=8):: w(ixG^T,nw),dtdiff_visc INTEGER:: ix^L,idim, ix_1,ix_2 INTEGER:: aa ! For spatially varying nu you need a common nu array - DOUBLE PRECISION::tmpdt(ixG^T), nuL(ixG^T),nuR(ixG^T), nushk(ixG^T,ndim) + REAL(kind=8)::tmpdt(ixG^T), nuL(ixG^T),nuR(ixG^T), nushk(ixG^T,ndim) COMMON/visc/nuL COMMON/visc/nuR !----------------------------------------------------------------------------- @@ -552,7 +552,7 @@ SUBROUTINE gradient1(q,ix^L,idim,gradq) USE constants USE common_variables INTEGER:: ix^L,idim - DOUBLE PRECISION:: q(ixG^T),gradq(ixG^T) + REAL(kind=8):: q(ixG^T),gradq(ixG^T) INTEGER:: hx^L,kx^L INTEGER:: minx1^D,maxx1^D,k !----------------------------------------------------------------------------- @@ -599,7 +599,7 @@ SUBROUTINE gradient1L(q,ix^L,idim,gradq) USE constants USE common_variables INTEGER:: ix^L,idim - DOUBLE PRECISION:: q(ixG^T),gradq(ixG^T) + REAL(kind=8):: q(ixG^T),gradq(ixG^T) INTEGER:: hx^L INTEGER:: minx1^D,maxx1^D,k !----------------------------------------------------------------------------- @@ -644,7 +644,7 @@ SUBROUTINE gradient1R(q,ix^L,idim,gradq) USE constants USE common_variables INTEGER:: ix^L,idim - DOUBLE PRECISION:: q(ixG^T),gradq(ixG^T) + REAL(kind=8):: q(ixG^T),gradq(ixG^T) INTEGER:: hx^L INTEGER:: minx1^D,maxx1^D,k !----------------------------------------------------------------------------- From d45466c9d9c70461f9ec5894d0727a781bb8319f Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Wed, 30 Jul 2014 18:03:48 +0100 Subject: [PATCH 08/32] SAVE ALL THE THINGS. We now write all arrays in 3D, always. The dataset creation code is now in vacio.t because of a bug in gcc-fortran, or at least what looks like one. --- sac/src/Makefile | 2 +- sac/src/fgdfio | 2 +- sac/src/sacgdf.t | 11 ++- sac/src/vacio.t | 227 ++++++++++++++++++++++++++++++++++++++++++++--- 4 files changed, 224 insertions(+), 18 deletions(-) diff --git a/sac/src/Makefile b/sac/src/Makefile index 0ba9dd4..35da7a4 100644 --- a/sac/src/Makefile +++ b/sac/src/Makefile @@ -87,7 +87,7 @@ gdf : $(FOR) $(FORFLG) -c $(GDF_INCLUDES) vac : gdf $(VACOBJ) $(LIBS_) - $(FOR) $(FORFLG) -o $(VACDIR)/vac $(VACOBJ) $(LIBS) $(GDF_INCLUDES) + $(FOR) $(FORFLG) -o $(VACDIR)/vac $(GDF_INCLUDES) $(VACOBJ) $(LIBS) ###### Removing object files, precompiled Fortran files, and symbolic links diff --git a/sac/src/fgdfio b/sac/src/fgdfio index 4d28c61..83abbe7 160000 --- a/sac/src/fgdfio +++ b/sac/src/fgdfio @@ -1 +1 @@ -Subproject commit 4d28c61623c65fe2b98271f2d1952fdd418ff420 +Subproject commit 83abbe78b1204782cc56b6cdaa1d59a7ddb498f4 diff --git a/sac/src/sacgdf.t b/sac/src/sacgdf.t index 3f7bb8c..c9624a8 100644 --- a/sac/src/sacgdf.t +++ b/sac/src/sacgdf.t @@ -22,6 +22,11 @@ contains + + + + + subroutine sacgdf_write_eqpar(file_id) ! Convert simulation parameters to the eqpar array use common_variables @@ -78,11 +83,11 @@ contains select case (nw) case (7) - call sacgdf_make_field_types_1D(field_types) + {^IFONED call sacgdf_make_field_types_1D(field_types) } case (10) - call sacgdf_make_field_types_2D(field_types) + {^IFTWOD call sacgdf_make_field_types_2D(field_types) } case (13) - call sacgdf_make_field_types_3D(field_types) + {^IFTHREED call sacgdf_make_field_types_3D(field_types) } case default call die("Wrong nw") end select diff --git a/sac/src/vacio.t b/sac/src/vacio.t index ee3d044..61e0bf0 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -1123,7 +1123,7 @@ SUBROUTINE savefileout_gdf(w,ix^L) USE hdf5 use gdf use sacgdf - use gdf_datasets + use gdf_datasets, only: write_dataset USE common_variables IMPLICIT NONE @@ -1139,12 +1139,19 @@ SUBROUTINE savefileout_gdf(w,ix^L) character(len=8) :: itstr + integer, dimension(3) :: gdf_nx type(gdf_root_datasets_T) :: rd type(gdf_parameters_T) :: gdf_sp type(gdf_field_type_T), dimension(nw) :: field_types - class(*), dimension(:^D&), pointer :: d_ptr - real(kind=8), dimension(ix^S), target :: wdata + class(*), dimension(:, :, :), pointer :: d_ptr + real(kind=8), dimension(ix^S) :: wdata + real(kind=8), dimension(:, :, :), allocatable, target :: wdata3D + + gdf_nx = (/ 1, 1, 1 /) + gdf_nx(:^ND) = nx + print*, gdf_nx + allocate(wdata3D(1:gdf_nx(1), 1:gdf_nx(2), 1:gdf_nx(3))) ! Open file CALL h5open_f(error) @@ -1152,17 +1159,17 @@ SUBROUTINE savefileout_gdf(w,ix^L) call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, error) ! Create the file ! Convert the current iteration to a string - write(itstr, '(I8.8)') it + write(itstr, '(I8.8)') int(it) call h5fcreate_f(TRIM(filenameout)//itstr//'.gdf', H5F_ACC_TRUNC_F, file_id, error, access_prp=plist_id) ! Create ! Simulation Parameters - call gdf_sp%init(^ND) + call gdf_sp%init() gdf_sp%boundary_conditions = (/ 2, 2, 2, 2, 2, 2 /) gdf_sp%cosmological_simulation = 0 gdf_sp%current_time = t gdf_sp%dimensionality = ^ND - gdf_sp%domain_dimensions = nx ! on disk + gdf_sp%domain_dimensions = gdf_nx ! on disk gdf_sp%domain_left_edge = x(ixmin^D, :) !bottom left corner gdf_sp%domain_right_edge = x(ixmax^D, :) ! top right corner gdf_sp%field_ordering = 1 @@ -1171,11 +1178,11 @@ SUBROUTINE savefileout_gdf(w,ix^L) gdf_sp%unique_identifier = "sacgdf2014" ! Initilize the data - call rd%init(^ND, 1) + call rd%init(1) rd%grid_parent_id = 0 rd%grid_left_index(:, 1) = (/ 0, 0 /) - rd%grid_dimensions(:, 1) = nx + rd%grid_dimensions(:, 1) = gdf_nx rd%grid_level = 0 rd%grid_particle_count(:, 1) = (/ 0 /) @@ -1189,12 +1196,8 @@ SUBROUTINE savefileout_gdf(w,ix^L) call h5gcreate_f(dom_g_id, "grid_0000000000", doml_g_id, error) !Create the top grid ! WRITE ACTUAL DATA HERE + call sacgdf_write_datasets(doml_g_id, plist_id, w, ix^L) - wdata(ix^S) = w(ix^S, m1_) / (w(ix^S, rho_) + w(ix^S, rhob_)) - d_ptr => wdata - call write_dataset(doml_g_id, 'velocity_x', d_ptr, plist_id) - - CALL h5fclose_f(file_id, error) CALL h5close_f(error) @@ -1290,4 +1293,202 @@ END SUBROUTINE flushunit !############################################################################## + subroutine sacgdf_write_datasets(place, plist_id, w, ix^L) + use hdf5, only: HID_T + use gdf_datasets + use common_variables, only: ixGhi^D, ixGlo^D, nw + + implicit none + + integer(HID_T), intent(inout) :: place + integer(HID_T), intent(inout) :: plist_id !< Property list identifier + integer, intent(in) :: ix^L + real(kind=8), intent(in):: w(ixG^T,nw) + + + call sacgdf_write_datasets_1D(place, plist_id, w, ix^L) + {^IFTWOD call sacgdf_write_datasets_2D(place, plist_id, w, ix^L) } + {^IFTHREED call sacgdf_write_datasets_3D(place, plist_id, w, ix^L) } + + end subroutine sacgdf_write_datasets + + subroutine sacgdf_write_datasets_1D(place, plist_id, w, ix^L) + use hdf5, only: HID_T + use gdf_datasets, only: write_dataset + use common_variables, only: rho_, rhob_, e_, eb_, m1_, b1_, bg1_ + use common_variables, only: ixGhi^D, ixGlo^D, nw, nx + + implicit none + + integer(HID_T), intent(inout) :: place + integer(HID_T), intent(inout) :: plist_id !< Property list identifier + integer, intent(in) :: ix^L + real(kind=8), intent(in) :: w(ixG^T,nw) + + !integer :: error + integer, dimension(3) :: gdf_nx + class(*), dimension(:, :, :), pointer :: d_ptr + real(kind=8), dimension(ix^S), target :: wdata + real(kind=8), dimension(:, :, :), allocatable, target :: wdata3D + + gdf_nx = (/ 1, 1, 1 /) + gdf_nx(:^ND) = nx + allocate(wdata3D(1:gdf_nx(1), 1:gdf_nx(2), 1:gdf_nx(3))) + + ! Velocity + wdata(ix^S) = w(ix^S, m1_) / (w(ix^S, rho_) + w(ix^S, rhob_)) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'velocity_x', d_ptr, plist_id) + + ! Density pert + wdata(ix^S) = w(ix^S, rho_) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'denisty_pert', d_ptr, plist_id) + + ! Denisty bg + wdata(ix^S) = w(ix^S, rhob_) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'density_bg', d_ptr, plist_id) + + ! Mag field pert + wdata(ix^S) = w(ix^S, b1_) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'mag_field_x_pert', d_ptr, plist_id) + + ! Mag field bg + wdata(ix^S) = w(ix^S, bg1_) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'mag_field_x_bg', d_ptr, plist_id) + + ! internal energy pert + wdata(ix^S) = w(ix^S, e_) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'internal_energy_pert', d_ptr, plist_id) + + ! internal energy bg + wdata(ix^S) = w(ix^S, eb_) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'internal_energy_bg', d_ptr, plist_id) + + + end subroutine sacgdf_write_datasets_1D + + +{^IFTWOD + subroutine sacgdf_write_datasets_2D(place, plist_id, w, ix^L) + use hdf5, only: HID_T + use gdf_datasets, only: write_dataset + use common_variables, only: rho_, rhob_, m2_, b2_, bg2_ + use common_variables, only: ixGhi^D, ixGlo^D, nw, nx + + implicit none + + integer(HID_T), intent(inout) :: place + integer(HID_T), intent(inout) :: plist_id !< Property list identifier + integer, intent(in) :: ix^L + real(kind=8), intent(in) :: w(ixG^T,nw) + + integer :: error + integer, dimension(3) :: gdf_nx + class(*), dimension(:, :, :), pointer :: d_ptr + real(kind=8), dimension(ix^S), target :: wdata + real(kind=8), dimension(:, :, :), allocatable, target :: wdata3D + + gdf_nx = (/ 1, 1, 1 /) + gdf_nx(:^ND) = nx + allocate(wdata3D(1:gdf_nx(1), 1:gdf_nx(2), 1:gdf_nx(3))) + + ! Velocity + wdata(ix^S) = w(ix^S, m2_) / (w(ix^S, rho_) + w(ix^S, rhob_)) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'velocity_y', d_ptr, plist_id) + + ! Mag field pert + wdata(ix^S) = w(ix^S, b2_) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'mag_field_y_pert', d_ptr, plist_id) + + ! Mag field bg + wdata(ix^S) = w(ix^S, bg2_) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'mag_field_y_bg', d_ptr, plist_id) + + + end subroutine sacgdf_write_datasets_2D +} +{^IFTHREED + subroutine sacgdf_write_datasets_3D(place, plist_id, w, ix^L) + use hdf5, only: HID_T + use gdf_datasets, only: write_dataset + use common_variables, only: rho_, rhob_, m3_, b3_, bg3_ + use common_variables, only: ixGhi^D, ixGlo^D, nw, nx + + implicit none + + integer(HID_T), intent(inout) :: place + integer(HID_T), intent(inout) :: plist_id !< Property list identifier + integer, intent(in) :: ix^L + real(kind=8), intent(in) :: w(ixG^T,nw) + + integer :: error + integer, dimension(3) :: gdf_nx + class(*), dimension(:, :, :), pointer :: d_ptr + real(kind=8), dimension(ix^S), target :: wdata + real(kind=8), dimension(:, :, :), allocatable, target :: wdata3D + + gdf_nx = (/ 1, 1, 1 /) + gdf_nx(:^ND) = nx + allocate(wdata3D(1:gdf_nx(1), 1:gdf_nx(2), 1:gdf_nx(3))) + + ! Velocity + wdata(ix^S) = w(ix^S, m2_) / (w(ix^S, rho_) + w(ix^S, rhob_)) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'velocity_y', d_ptr, plist_id) + + ! Mag field pert + wdata(ix^S) = w(ix^S, b2_) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'mag_field_y_pert', d_ptr, plist_id) + + ! Mag field bg + wdata(ix^S) = w(ix^S, bg2_) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'mag_field_y_bg', d_ptr, plist_id) + + ! Velocity + wdata(ix^S) = w(ix^S, m3_) / (w(ix^S, rho_) + w(ix^S, rhob_)) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'velocity_z', d_ptr, plist_id) + + ! Mag field pert + wdata(ix^S) = w(ix^S, b3_) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'mag_field_z_pert', d_ptr, plist_id) + + ! Mag field bg + wdata(ix^S) = w(ix^S, bg3_) + wdata3D = reshape(wdata, gdf_nx) + d_ptr => wdata3D + call write_dataset(place, 'mag_field_z_bg', d_ptr, plist_id) + + + end subroutine sacgdf_write_datasets_3D +} + + From bdbdfcca5cade7780b69f2abe68a1181dbbca926 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Thu, 31 Jul 2014 16:49:24 +0100 Subject: [PATCH 09/32] First pass at initial condition reading. --- sac/par/mhdmodes | 5 +- sac/src/fgdfio | 2 +- sac/src/sacgdf.t | 153 +++++++++++++++++++++++++++++++++++------------ sac/src/vacio.t | 95 +++++++++++++++++++++++++++-- 4 files changed, 209 insertions(+), 46 deletions(-) diff --git a/sac/par/mhdmodes b/sac/par/mhdmodes index 8ef0abf..72357be 100644 --- a/sac/par/mhdmodes +++ b/sac/par/mhdmodes @@ -3,9 +3,9 @@ / &filelist - filenameini='/archive/io_testing/mhdmodes_2D.ini' + filenameini='/archive/mhdmodes_2D_ini.gdf' - typefileini='binary' + typefileini='gdf' filename= '/archive/mhdmodes_2D.log', '/archive/mhdmodes_2D_' typefileout='gdf' @@ -15,6 +15,7 @@ &savelist dtsave=1,0.1 + itsave(1,2)=0 / diff --git a/sac/src/fgdfio b/sac/src/fgdfio index 83abbe7..b2b562c 160000 --- a/sac/src/fgdfio +++ b/sac/src/fgdfio @@ -1 +1 @@ -Subproject commit 83abbe78b1204782cc56b6cdaa1d59a7ddb498f4 +Subproject commit b2b562cb7f3cda779bb8edbbe5746327c223fa0d diff --git a/sac/src/sacgdf.t b/sac/src/sacgdf.t index c9624a8..b7842af 100644 --- a/sac/src/sacgdf.t +++ b/sac/src/sacgdf.t @@ -3,25 +3,42 @@ module sacgdf contains - subroutine sacgdf_write_file(file_id, rd, gdf_sp, field_types) + subroutine sacgdf_write_file(file_id, gdf_rd, gdf_sp, field_types) use hdf5, only: HID_T use gdf, only: gdf_write_file, gdf_root_datasets_T, gdf_parameters_T, gdf_field_type_T implicit none integer(HID_T), intent(inout) :: file_id - type(gdf_root_datasets_T), intent(in) :: rd - type(gdf_parameters_T), intent(in) :: gdf_sp - type(gdf_field_type_T), dimension(:), intent(in) :: field_types - - call gdf_write_file(file_id, "Sheffield Advanced Code", "GDF Testing version", & - rd, gdf_sp, field_types) + type(gdf_root_datasets_T), intent(inout) :: gdf_rd + type(gdf_parameters_T), intent(inout) :: gdf_sp + type(gdf_field_type_T), dimension(:), intent(inout) :: field_types + call gdf_write_file(file_id, "Sheffield Advanced Code", "GDF Testing version", & + gdf_rd, gdf_sp, field_types) + call sacgdf_write_eqpar(file_id) end subroutine sacgdf_write_file + subroutine sacgdf_read_file(file_id, software_name, software_version, & + gdf_rd, gdf_sp, field_types) + use hdf5, only: HID_T + use gdf, only: gdf_read_file, gdf_root_datasets_T, gdf_parameters_T, gdf_field_type_T + implicit none + + integer(HID_T), intent(inout) :: file_id + type(gdf_root_datasets_T), intent(inout) :: gdf_rd + type(gdf_parameters_T), intent(inout) :: gdf_sp + type(gdf_field_type_T), dimension(:), allocatable, intent(inout) :: field_types + character(len=*), intent(out) :: software_name, software_version + + call gdf_read_file(file_id, software_name, software_version, & + gdf_rd, gdf_sp, field_types) + call sacgdf_read_eqpar(file_id) + + end subroutine sacgdf_read_file @@ -40,6 +57,8 @@ contains integer(HID_T) :: g_id integer :: error real(kind=8), dimension(:), pointer :: r_ptr + integer(kind=4), dimension(:), pointer :: i4_ptr + integer(kind=4), dimension(1), target :: it_arr call h5gopen_f(file_id, 'simulation_parameters', g_id, error) @@ -62,6 +81,8 @@ contains } {^IFTHREED + r_ptr => eqpar(grav2_:grav2_) + call create_attribute(g_id, 'gravity2', r_ptr r_ptr => eqpar(grav3_:grav3_) call create_attribute(g_id, 'gravity3', } @@ -69,6 +90,10 @@ contains r_ptr => eqpar(nu_:nu_) call create_attribute(g_id, 'nu', r_ptr) + it_arr(1) = it + i4_ptr => it_arr + call create_attribute(g_id, 'current_iteration', i4_ptr) + call h5gclose_f(g_id, error) end subroutine sacgdf_write_eqpar @@ -220,36 +245,86 @@ contains end subroutine sacgdf_make_field_types_3D -!!$ subroutine sacgdf_read_eqpar(file_id, dimensionality) -!!$ ! Convert simulation parameters to the eqpar array -!!$ use common_variables -!!$ use hdf5, only: HID_T, h5gopen_f, h5gclose_f -!!$ use helpers_hdf5, only: read_attribute -!!$ -!!$ implicit none -!!$ -!!$ integer(HID_T), intent(in) :: file_id -!!$ integer, intent(in) :: dimensionality -!!$ -!!$ integer(HID_T) :: g_id -!!$ integer :: error -!!$ -!!$ -!!$ call h5gopen_f(file_id, 'simulation_parameters', g_id, error) -!!$ call read_attribute(g_id, 'gamma', eqpar(gamma_)) -!!$ call read_attribute(g_id, 'eta', eqpar(eta_)) -!!$ call read_attribute(g_id, 'gravity0', eqpar(grav0_)) -!!$ call read_attribute(g_id, 'gravity1', eqpar(grav1_)) -!!$ ! Read the extra parameters only if we are 2D or 3D -!!$ {^IFTWOD -!!$ call read_attribute(g_id, 'gravity2', eqpar(grav2_)) -!!$ } -!!$ {^IFTHREED -!!$ call read_attribute(g_id, 'gravity3', eqpar(grav3_)) -!!$ } -!!$ call read_attribute(g_id, 'nu', eqpar(nu_)) -!!$ call h5close_f(g_id, error) -!!$ -!!$ end subroutine sacgdf_read_eqpar - + subroutine sacgdf_read_eqpar(file_id) + ! Convert simulation parameters to the eqpar array + use common_variables + use hdf5, only: HID_T, h5gopen_f, h5gclose_f + use helpers_hdf5, only: read_attribute + + implicit none + + integer(HID_T), intent(in) :: file_id + + integer(HID_T) :: g_id + integer :: error + + real(kind=8), dimension(:), pointer :: r_ptr + integer(kind=4), dimension(:), pointer :: i4_ptr + integer(kind=4), dimension(1), target :: it_arr + + + call h5gopen_f(file_id, 'simulation_parameters', g_id, error) + r_ptr => eqpar(gamma_:gamma_) + call read_attribute(g_id, 'gamma', r_ptr) + + r_ptr => eqpar(eta_:eta_) + call read_attribute(g_id, 'eta', r_ptr) + + r_ptr => eqpar(grav0_:grav0_) + call read_attribute(g_id, 'gravity0', r_ptr) + + r_ptr => eqpar(grav1_:grav1_) + call read_attribute(g_id, 'gravity1', r_ptr) + + ! Read the extra parameters only if we are 2D or 3D + {^IFTWOD + r_ptr => eqpar(grav2_:grav2_) + call read_attribute(g_id, 'gravity2', r_ptr) + } + {^IFTHREED + r_ptr => eqpar(grav2_:grav2_) + call read_attribute(g_id, 'gravity2', r_ptr) + r_ptr => eqpar(grav3_:grav3_) + call read_attribute(g_id, 'gravity3', r_ptr) + } + + r_ptr => eqpar(nu_:nu_) + call read_attribute(g_id, 'nu', r_ptr) + + i4_ptr => it_arr + call read_attribute(g_id, 'current_iteration', i4_ptr) + it = it_arr(1) + + call h5gclose_f(g_id, error) + + end subroutine sacgdf_read_eqpar + + subroutine build_x_array(ix^L, nx, left_edge, right_edge, x) + ! Construct the x array (which is cell centred) from the left_edge and right_edge + ! values, which are also assumed to be cell centred. + implicit none + + integer, intent(in) :: ix^L + integer, dimension(^ND), intent(in) :: nx + real(kind=8), dimension(^ND), intent(in) :: left_edge, right_edge + real(kind=8), dimension(:^D&,:), intent(inout) :: x + + integer :: ix^D + real(kind=8) :: dx^D + +!!$ ! Set ixmin = 1 +!!$ ixmin^D=1; +!!$ ! Set ixmax to ixmin+nx +!!$ ixmax^D=ixmin^D+nx(^D)-1; + + dx^D=(right_edge(^D)-left_edge(^D))/nx(^D); + + { + forall(ix^DD=ixmin^DD:ixmax^DD) + x(ix^DD,^D)= ((ix^D-ixmin^D)*right_edge(^D) + (ixmax^D-ix^D)*left_edge(^D)) / (ixmax^D-ixmin^D) + end forall + \} + + end subroutine build_x_array + end module sacgdf diff --git a/sac/src/vacio.t b/sac/src/vacio.t index 61e0bf0..b0c442c 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -585,6 +585,8 @@ SUBROUTINE readfileini(w) CALL readfileini_asc(w) CASE('binary') CALL readfileini_bin(w) + CASE ('gdf') + CALL readfileini_gdf(w) CASE default CALL die('Error in VAC: Unknown typefileini='//typefileini) END SELECT @@ -774,6 +776,90 @@ SUBROUTINE readfileini_bin(w) RETURN END SUBROUTINE readfileini_bin +subroutine readfileini_gdf(w) + + use gdf, only: gdf_parameters_T, gdf_root_datasets_T, gdf_field_type_T + use hdf5, only: h5open_f, h5gopen_f, h5fopen_f, h5fclose_f, h5close_f, HID_T, H5F_ACC_RDONLY_F + use sacgdf, only: sacgdf_read_file, build_x_array + use gdf_datasets, only: read_dataset + use common_variables, only: ixGlo^D, ixGhi^D, nw, filenameini, nx, x, t, gencoord, fileheadini + + implicit none + + real(kind=8), intent(in) :: w(ixG^T,nw) + + integer(kind=4) :: error + integer(HID_T) :: file_id, grid_g_id, grid_z_id + type(gdf_parameters_T) :: gdf_sp + type(gdf_root_datasets_T) :: gdf_rd + type(gdf_field_type_T), dimension(:), allocatable :: field_types + character(len=60) :: software_name, software_version + class(*), dimension(:, :, :), pointer :: r_ptr + real(kind=8), dimension(:, :, :), allocatable, target :: wdata3D + + integer:: ndimini,neqparini,neqparin,nwini,nwin ! values describing input data + integer:: ix^L + + + ! just in case you are reading in a gdf and saving out a binary + fileheadini = 'gdf' + + ! Open the interface + call h5open_f(error) + + ! Open a file for reading only + call h5fopen_f(trim(filenameini), H5F_ACC_RDONLY_F, file_id, error) + + ! init the objects + call gdf_sp%init() + call gdf_rd%init(1) + + ! Read the file + call sacgdf_read_file(file_id, software_name, software_version, & + gdf_rd, gdf_sp, field_types) + + ! Decode the gdf data structures + t = gdf_sp%current_time(1) + ndimini = gdf_sp%dimensionality(1) + nwini = size(field_types, 1) + ! Set neqpar + {^IFONED neqparini = 5} + {^IFTWOD neqparini = 6} + {^IFTHREED neqparini = 7} + gencoord = ndimini<0 + ! Validate parameters? + call checkNdimNeqparNw(ndimini,neqparini,nwini,neqparin,nwin) + + nx = gdf_sp%domain_dimensions(:ndimini) + + ! This set's up the global indicies based on nx and also + ! deals with the MPI indicies etc. + call setixGixMix(ix^L) + + ! Build the x array + call build_x_array(ix^L, nx, gdf_sp%domain_left_edge(:ndimini), gdf_sp%domain_right_edge(:ndimini), x) + + ! Reconstruct the w array + ! Allocate the wdata3D array + allocate(wdata3D(gdf_sp%domain_dimensions(1), & + gdf_sp%domain_dimensions(2), & + gdf_sp%domain_dimensions(3))) + + ! Create field groups + call h5gopen_f(file_id, "data", grid_g_id, error) !Create /data + call h5gopen_f(grid_g_id, "grid_0000000000", grid_z_id, error) !Create the top grid + + r_ptr => wdata3D + call read_dataset(grid_z_id, 'density_bg', r_ptr) + + print*, maxval(wdata3D) + + + ! Close the file and interface + call h5fclose_f(file_id, error) + call h5close_f(error) +end subroutine readfileini_gdf + !============================================================================= SUBROUTINE checkNdimNeqparNw(ndimini,neqparini,nwini,neqparin,nwin) @@ -1170,8 +1256,10 @@ SUBROUTINE savefileout_gdf(w,ix^L) gdf_sp%current_time = t gdf_sp%dimensionality = ^ND gdf_sp%domain_dimensions = gdf_nx ! on disk - gdf_sp%domain_left_edge = x(ixmin^D, :) !bottom left corner - gdf_sp%domain_right_edge = x(ixmax^D, :) ! top right corner + gdf_sp%domain_left_edge = (/ 0, 0, 0 /) + gdf_sp%domain_right_edge = (/ 0, 0, 0 /) + gdf_sp%domain_left_edge(:^ND) = x(ixmin^D, :) !bottom left corner + gdf_sp%domain_right_edge(:^ND) = x(ixmax^D, :) ! top right corner gdf_sp%field_ordering = 1 gdf_sp%num_ghost_zones = 0 !on disk gdf_sp%refine_by = 0 @@ -1292,7 +1380,6 @@ END SUBROUTINE flushunit ! end module vacio !############################################################################## - subroutine sacgdf_write_datasets(place, plist_id, w, ix^L) use hdf5, only: HID_T use gdf_datasets @@ -1345,7 +1432,7 @@ END SUBROUTINE flushunit wdata(ix^S) = w(ix^S, rho_) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'denisty_pert', d_ptr, plist_id) + call write_dataset(place, 'density_pert', d_ptr, plist_id) ! Denisty bg wdata(ix^S) = w(ix^S, rhob_) From 017c209f5fb24f8e39f346a64d70c0de4fbaf61b Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Fri, 1 Aug 2014 13:40:06 +0100 Subject: [PATCH 10/32] what the bug bug. --- sac/src/fgdfio | 2 +- sac/src/vacio.t | 12 ++++-------- 2 files changed, 5 insertions(+), 9 deletions(-) diff --git a/sac/src/fgdfio b/sac/src/fgdfio index b2b562c..91aef2c 160000 --- a/sac/src/fgdfio +++ b/sac/src/fgdfio @@ -1 +1 @@ -Subproject commit b2b562cb7f3cda779bb8edbbe5746327c223fa0d +Subproject commit 91aef2c5dca4b1d12774ed3a902ff42e87662e68 diff --git a/sac/src/vacio.t b/sac/src/vacio.t index b0c442c..a46dc0a 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -808,6 +808,7 @@ subroutine readfileini_gdf(w) call h5open_f(error) ! Open a file for reading only + print*, trim(filenameini) call h5fopen_f(trim(filenameini), H5F_ACC_RDONLY_F, file_id, error) ! init the objects @@ -840,19 +841,14 @@ subroutine readfileini_gdf(w) call build_x_array(ix^L, nx, gdf_sp%domain_left_edge(:ndimini), gdf_sp%domain_right_edge(:ndimini), x) ! Reconstruct the w array - ! Allocate the wdata3D array - allocate(wdata3D(gdf_sp%domain_dimensions(1), & - gdf_sp%domain_dimensions(2), & - gdf_sp%domain_dimensions(3))) - ! Create field groups call h5gopen_f(file_id, "data", grid_g_id, error) !Create /data call h5gopen_f(grid_g_id, "grid_0000000000", grid_z_id, error) !Create the top grid r_ptr => wdata3D - call read_dataset(grid_z_id, 'density_bg', r_ptr) - - print*, maxval(wdata3D) + call read_dataset(grid_z_id, 'internal_energy_pert', r_ptr) + print*, shape(wdata3D) + print*, wdata3D(50,50,1) ! Close the file and interface From bd91b09addcaceb21b1dc4d892fcd12849628b5e Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Tue, 9 Sep 2014 18:48:31 +0100 Subject: [PATCH 11/32] Make read kinda work, code still not running. --- sac/par/{mhdmodes => gdfini} | 2 +- sac/par/gdfout | 52 ++ sac/src/fgdfio | 2 +- sac/src/sacgdf.t | 152 +++++ sac/src/vacio.t | 1249 +++++++++++++++++----------------- 5 files changed, 829 insertions(+), 628 deletions(-) rename sac/par/{mhdmodes => gdfini} (94%) create mode 100644 sac/par/gdfout diff --git a/sac/par/mhdmodes b/sac/par/gdfini similarity index 94% rename from sac/par/mhdmodes rename to sac/par/gdfini index 72357be..fa67609 100644 --- a/sac/par/mhdmodes +++ b/sac/par/gdfini @@ -7,7 +7,7 @@ typefileini='gdf' filename= '/archive/mhdmodes_2D.log', - '/archive/mhdmodes_2D_' + '/archive/mhdmodes_2D' typefileout='gdf' fullgridout= F fullgridini= T diff --git a/sac/par/gdfout b/sac/par/gdfout new file mode 100644 index 0000000..9ffa016 --- /dev/null +++ b/sac/par/gdfout @@ -0,0 +1,52 @@ +&testlist + teststr='readfileini' +/ + +&filelist + filenameini='/archive/io_testing/mhdmodes_2D.ini' + + typefileini='binary' + filename= '/archive/mhdmodes_2D.log', + '/archive/mhdmodes_2D' + typefileout='gdf' + fullgridout= F + fullgridini= T + / + +&savelist + dtsave=1,0.1 + itsave(1,2)=0 + + / + + &stoplist + tmax=0.2d0 + itmax = 10000 + / + + &methodlist + + wnames= 'h m1 m2 e b1 b2 eb rhob bg1 bg2' + typefull= 6*'cd4',4*'nul' + typeadvance= 'onestep' + typefilter= 10*'nul' + dimsplit= F + sourcesplit= F + divBfix= F + smallp= 10.d0 + / + + &boundlist + typeB= 10*'fixed' + 10*'fixed' + 10*'fixed' + 10*'fixed' + 10*'fixed' + 10*'fixed' + + / + + ¶mlist + courantpar=0.2 + + / diff --git a/sac/src/fgdfio b/sac/src/fgdfio index 91aef2c..c543cba 160000 --- a/sac/src/fgdfio +++ b/sac/src/fgdfio @@ -1 +1 @@ -Subproject commit 91aef2c5dca4b1d12774ed3a902ff42e87662e68 +Subproject commit c543cba516e536b68b65e4e47c651dea0dd72a0f diff --git a/sac/src/sacgdf.t b/sac/src/sacgdf.t index b7842af..86a2147 100644 --- a/sac/src/sacgdf.t +++ b/sac/src/sacgdf.t @@ -327,4 +327,156 @@ contains end subroutine build_x_array + subroutine sacgdf_read_datasets(place, plist_id, w, ix^L) + use hdf5, only: HID_T + use gdf_datasets + use common_variables, only: ixGhi^D, ixGlo^D, nw + + implicit none + + integer(HID_T), intent(inout) :: place + integer(HID_T), intent(inout) :: plist_id !< Property list identifier + integer, intent(in) :: ix^L + real(kind=8), intent(inout):: w(ixG^T,nw) + + + call sacgdf_read_datasets_1D(place, plist_id, w, ix^L) + {^IFTWOD call sacgdf_read_datasets_2D(place, plist_id, w, ix^L) } + {^IFTHREED call sacgdf_read_datasets_3D(place, plist_id, w, ix^L) } + + end subroutine sacgdf_read_datasets + + subroutine sacgdf_read_datasets_1D(place, plist_id, w, ix^L) + use hdf5, only: HID_T + use gdf_datasets, only: read_real_dataset + use common_variables, only: rho_, rhob_, e_, eb_, m1_, b1_, bg1_ + use common_variables, only: ixGhi^D, ixGlo^D, nw, nx + + implicit none + + integer(HID_T), intent(inout) :: place + integer(HID_T), intent(inout) :: plist_id !< Property list identifier + integer, intent(in) :: ix^L + real(kind=8), intent(inout) :: w(ixG^T,nw) + + real(kind=8), dimension(:, :, :), allocatable :: wdata3D + + ! Density pert + call read_real_dataset(place, 'density_pert', wdata3D) + w(ix^S, rho_) = reshape(wdata3D, nx) + deallocate(wdata3D) + + ! Denisty bg + call read_real_dataset(place, 'density_bg', wdata3D) + w(ix^S, rhob_) = reshape(wdata3D, nx) + deallocate(wdata3D) + + ! Velocity + call read_real_dataset(place, 'velocity_x', wdata3D) + w(ix^S, m1_) = reshape(wdata3D, nx) * (w(ix^S, rho_) + w(ix^S, rhob_)) + deallocate(wdata3D) + + ! internal energy pert + call read_real_dataset(place, 'internal_energy_pert', wdata3D) + w(ix^S, e_) = reshape(wdata3D, nx) + deallocate(wdata3D) + + ! internal energy bg + call read_real_dataset(place, 'internal_energy_bg', wdata3D) + w(ix^S, eb_) = reshape(wdata3D, nx) + deallocate(wdata3D) + + ! Mag field pert + call read_real_dataset(place, 'mag_field_x_pert', wdata3D) + w(ix^S, b1_) = reshape(wdata3D, nx) + deallocate(wdata3D) + + ! Mag field bg + call read_real_dataset(place, 'mag_field_x_bg', wdata3D) + w(ix^S, bg1_) = reshape(wdata3D, nx) + deallocate(wdata3D) + + end subroutine sacgdf_read_datasets_1D + +{^IFTWOD + subroutine sacgdf_read_datasets_2D(place, plist_id, w, ix^L) + use hdf5, only: HID_T + use gdf_datasets, only: read_real_dataset + use common_variables, only: rho_, rhob_, m2_, b2_, bg2_ + use common_variables, only: ixGhi^D, ixGlo^D, nw, nx + + implicit none + + integer(HID_T), intent(inout) :: place + integer(HID_T), intent(inout) :: plist_id !< Property list identifier + integer, intent(in) :: ix^L + real(kind=8), intent(inout) :: w(ixG^T,nw) + + real(kind=8), dimension(:, :, :), allocatable :: wdata3D + + ! Velocity + call read_real_dataset(place, 'velocity_y', wdata3D) + w(ix^S, m2_) = reshape(wdata3D, nx) * (w(ix^S, rho_) + w(ix^S, rhob_)) + deallocate(wdata3D) + + ! Mag field pert + call read_real_dataset(place, 'mag_field_y_pert', wdata3D) + w(ix^S, b2_) = reshape(wdata3D, nx) + deallocate(wdata3D) + + ! Mag field bg + call read_real_dataset(place, 'mag_field_y_bg', wdata3D) + w(ix^S, bg2_) = reshape(wdata3D, nx) + deallocate(wdata3D) + + end subroutine sacgdf_read_datasets_2D +} +{^IFTHREED + subroutine sacgdf_read_datasets_3D(place, plist_id, w, ix^L) + use hdf5, only: HID_T + use gdf_datasets, only: read_real_dataset + use common_variables, only: rho_, rhob_, m3_, b3_, bg3_ + use common_variables, only: ixGhi^D, ixGlo^D, nw, nx + + implicit none + + integer(HID_T), intent(inout) :: place + integer(HID_T), intent(inout) :: plist_id !< Property list identifier + integer, intent(in) :: ix^L + real(kind=8), intent(inout) :: w(ixG^T,nw) + + real(kind=8), dimension(:, :, :), allocatable :: wdata3D + + ! Velocity + call read_real_dataset(place, 'velocity_y', wdata3D) + w(ix^S, m2_) = reshape(wdata3D, nx) * (w(ix^S, rho_) + w(ix^S, rhob_)) + deallocate(wdata3D) + + ! Mag field pert + call read_real_dataset(place, 'mag_field_y_pert', wdata3D) + w(ix^S, b2_) = reshape(wdata3D, nx) + deallocate(wdata3D) + + ! Mag field bg + call read_real_dataset(place, 'mag_field_y_bg', wdata3D) + w(ix^S, bg2_) = reshape(wdata3D, nx) + deallocate(wdata3D) + + ! Velocity + call read_real_dataset(place, 'velocity_z', wdata3D) + w(ix^S, m3_) = reshape(wdata3D, nx) * (w(ix^S, rho_) + w(ix^S, rhob_)) + deallocate(wdata3D) + + ! Mag field pert + call read_real_dataset(place, 'mag_field_z_pert', wdata3D) + w(ix^S, b3_) = reshape(wdata3D, nx) + deallocate(wdata3D) + + ! Mag field bg + call read_real_dataset(place, 'mag_field_z_bg', wdata3D) + w(ix^S, bg3_) = reshape(wdata3D, nx) + deallocate(wdata3D) + + end subroutine sacgdf_read_datasets_3D +} end module sacgdf diff --git a/sac/src/vacio.t b/sac/src/vacio.t index a46dc0a..028499c 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -1,23 +1,24 @@ + !############################################################################## ! module vacio !============================================================================= -SUBROUTINE readparameters(w) +subroutine readparameters(w) ! This subroutine sets or reads all default parameters from par/DEFAULT, ! then it reads the par/PROBLEM parameter file through standard input, ! and the initial data from data/PROBLEM.ini as soon as the filename is read ! from the parameter file. - USE constants - USE common_variables + use constants + use common_variables - REAL(kind=8):: w(ixG^T,nw) + real(kind=8):: w(ixG^T,nw) - CHARACTER(^LENTYPE):: typepred(nw),typefull(nw),typeimpl(nw),typefilter(nw) - REAL(kind=8):: muscleta - INTEGER:: i,j,k,iw,idim,iB,ifile,isave - LOGICAL:: implmrpc,globalixtest^IFMPI + character(^LENTYPE):: typepred(nw),typefull(nw),typeimpl(nw),typefilter(nw) + real(kind=8):: muscleta + integer:: i,j,k,iw,idim,iB,ifile,isave + logical:: implmrpc,globalixtest^IFMPI ! The use of NAMELIST is not recommended by Fortran 90. It could be replaced ! by some string manipulations, but that is difficult in Fortran 77/Adaptor. @@ -25,15 +26,15 @@ SUBROUTINE readparameters(w) ! SM: NAMELIST is a defined part of the F90+ specification. - NAMELIST /testlist/ teststr,ixtest1,ixtest2,ixtest3,& + namelist /testlist/ teststr,ixtest1,ixtest2,ixtest3,& iwtest,idimtest,ipetest^IFMPI - NAMELIST /filelist/ filenameini,filename,varnames{,^IFMPI npe^D}, & + namelist /filelist/ filenameini,filename,varnames{,^IFMPI npe^D}, & typefileini,typefileout,typefilelog,& snapshotini,snapshotout,fullgridini,fullgridout,dixB^L - NAMELIST /savelist/ tsave,itsave,dtsave,ditsave - NAMELIST /stoplist/ itmax,tmax,tmaxexact,dtmin,residmin,residmax,t,it,& + namelist /savelist/ tsave,itsave,dtsave,ditsave + namelist /stoplist/ itmax,tmax,tmaxexact,dtmin,residmin,residmax,t,it,& cputimemax - NAMELIST /methodlist/ wnames,fileheadout,eqpar,& + namelist /methodlist/ wnames,fileheadout,eqpar,& typeadvance,typefull,typepred,typeimpl,typefilter,& typelimiter,typeentropy,entropycoef,artcomp,& typelimited,typefct,typetvd,typeaxial,& @@ -46,8 +47,8 @@ SUBROUTINE readparameters(w) divbfix,divbwave,divbconstrain,angmomfix,compactres,& smallfix,smallp,smallpcoeff,smallrho,smallrhocoeff,& vacuumrho,nproc,procpar - NAMELIST /boundlist/ nB,typeB,ixB^LIM,idimB,upperB,extraB,typeBscalar,ipairB - NAMELIST /paramlist/ courantpar,dtpar,dtdiffpar,dtcantgrow,slowsteps,& + namelist /boundlist/ nB,typeB,ixB^LIM,idimB,upperB,extraB,typeBscalar,ipairB + namelist /paramlist/ courantpar,dtpar,dtdiffpar,dtcantgrow,slowsteps,& implmrpcpar,& implpar,impldiffpar,implerror,implrelax,impldwlimit,& implrestart,implrestart2,impliter,impliternr,& @@ -63,191 +64,191 @@ SUBROUTINE readparameters(w) ! Set default values for arrays (except the ones read from the inifile) - DO ifile=1,nfile - DO isave=1,nsavehi + do ifile=1,nfile + do isave=1,nsavehi tsave(isave,ifile)=bigdouble ! t of saves into the output files itsave(isave,ifile)=biginteger ! it of saves into the output files - END DO + end do dtsave(ifile)=bigdouble ! time between saves ditsave(ifile)=biginteger ! timesteps between saves isavet(ifile)=1 ! index for saves by t isaveit(ifile)=1 ! index for saves by it - END DO + end do - DO iw=1,nw + do iw=1,nw typepred(iw)='default' ! Predictor scheme (will be adjusted later) typefull(iw)='tvdlf' ! Full step scheme typeimpl(iw)='nul' ! Implicit step scheme typefilter(iw)='nul' ! Filter scheme typelimiter(iw)='minmod' ! Limiter type for flow variables/characteristics typeentropy(iw)='nul' ! Entropy fix type - artcomp(iw)=.FALSE. ! No artificial compression for Harten type TVD - END DO + artcomp(iw)=.false. ! No artificial compression for Harten type TVD + end do - DO iw=1,nw + do iw=1,nw acmcoef(iw)=-one ! Coefficients (0,1) for the dissipative fluxes - ENDDO ! negative value means no coefficient is used + enddo ! negative value means no coefficient is used - DO i=1,nfile+2 ! Elements define processing for the fullstep, + do i=1,nfile+2 ! Elements define processing for the fullstep, nproc(i)=0 ! halfstep and the nfile output files. If the value - END DO ! is 0, no processing. For nproc(1) and nproc(2) + end do ! is 0, no processing. For nproc(1) and nproc(2) ! the value defines the proc. frequency. Negative ! value results in a call at every sweep. Positive ! value N results in a call at every N-th step before ! the first sweep. For nproc(ifile+2) the nonzero ! values cause processing for that file. - DO i=1,nprocpar + do i=1,nprocpar procpar(i)=-one ! Parameters for processing - END DO + end do smallp=-one ! Default small pressure, redefined in getpthermal smallrho=-one ! Default small density, redefined in keeppositive vacuumrho=-one ! Density representing vacuum nB=2*ndim ! If nB is not specified by the user, gridsetup - DO iB=1,nhiB ! will create 2*ndim boundary regions by default. - DO iw=1,nw + do iB=1,nhiB ! will create 2*ndim boundary regions by default. + do iw=1,nw typeB(iw,iB) ='cont' ! Default boundary type - fixedB(iw,iB)=.FALSE. ! Fixed boundaries are not extrapolated into yet - END DO + fixedB(iw,iB)=.false. ! Fixed boundaries are not extrapolated into yet + end do ipairB(iB)=0 ! periodic pair is unknown, but can be set or guessed - END DO - DO iw=1,nw - DO idim=1,ndim - nofluxB(iw,idim)=.FALSE. ! No zero flux condition for variables - ENDDO - END DO + end do + do iw=1,nw + do idim=1,ndim + nofluxB(iw,idim)=.false. ! No zero flux condition for variables + enddo + end do dixB^L=2; ! Default width of boundary regions ixBmax(1,1)=0 ! An impossible value if user specifies boundaries. ! Read scalar parameters from the par/DEFAULT file unitpar=unitini-1 - OPEN(unitpar,file='par/DEFAULT',status='old') + open(unitpar,file='par/DEFAULT',status='old') - READ(unitpar,testlist) - READ(unitpar,filelist) - READ(unitpar,savelist) - READ(unitpar,stoplist) - READ(unitpar,methodlist) - READ(unitpar,boundlist) - READ(unitpar,paramlist) + read(unitpar,testlist) + read(unitpar,filelist) + read(unitpar,savelist) + read(unitpar,stoplist) + read(unitpar,methodlist) + read(unitpar,boundlist) + read(unitpar,paramlist) - CLOSE(unitpar) + close(unitpar) ! end defaults ! Initialize Kronecker delta, and Levi-Civita tensor - DO i=1,3 - DO j=1,3 - IF(i==j)THEN + do i=1,3 + do j=1,3 + if(i==j)then kr(i,j)=1 - ELSE + else kr(i,j)=0 - ENDIF - DO k=1,3 - IF(i==j.OR.j==k.OR.k==i)THEN + endif + do k=1,3 + if(i==j.or.j==k.or.k==i)then lvc(i,j,k)=0 - ELSE IF(i+1==j.OR.i-2==j)THEN + else if(i+1==j.or.i-2==j)then lvc(i,j,k)=1 - ELSE + else lvc(i,j,k)=-1 - ENDIF - ENDDO - ENDDO - ENDDO + endif + enddo + enddo + enddo ! Initialize error conunters and equation parameters - DO i=1,nerrcode + do i=1,nerrcode nerror(i)=0 - END DO - DO i=1,neqpar+nspecialpar + end do + do i=1,neqpar+nspecialpar eqpar(i)=zero - END DO + end do ! read from STDIN unitpar=unitstdin {^IFMPI ! MPI reads from a file unitpar=unitini-1 - OPEN(unitpar,file='vac.par',status='old') + open(unitpar,file='vac.par',status='old') } ! Start reading parameters from standard input, i.e. "< par/PROBLEM" {ipetest = -1 ^IFMPI} - READ(unitpar,testlist) + read(unitpar,testlist) {^IFMPI ! ixtest^D is given for the full grid if ipetest was not set explicitly globalixtest = ipetest < 0 - ipetest = MAX(ipetest,0) + ipetest = max(ipetest,0) ! Erase test string for other processors unless ipetest >= npe (test all PEs) - IF(ipetest=1 - IF(oktest) WRITE(unitterm,*)'ReadParameters' - IF(oktest) WRITE(unitterm,testlist) + oktest=index(teststr,'readparameters')>=1 + if(oktest) write(unitterm,*)'ReadParameters' + if(oktest) write(unitterm,testlist) varnames='default' - READ(unitpar,filelist) + read(unitpar,filelist) {^IFMPI ! Extract and check the directional processor numbers and indexes ! and concat the PE number to the input and output filenames - CALL mpisetnpeDipeD(filenameini) - CALL mpisetnpeDipeD(filename(fileout_)) + call mpisetnpeDipeD(filenameini) + call mpisetnpeDipeD(filename(fileout_)) } - IF(oktest) THEN - {^IFMPI WRITE(unitterm,*)'npe^D=',npe^D} - WRITE(unitterm,*)filenameini - DO ifile=1,nfile - WRITE(unitterm,*)filename(ifile) - ENDDO - WRITE(unitterm,*)'Type of ini/out and log files:',& + if(oktest) then + {^IFMPI write(unitterm,*)'npe^D=',npe^D} + write(unitterm,*)filenameini + do ifile=1,nfile + write(unitterm,*)filename(ifile) + enddo + write(unitterm,*)'Type of ini/out and log files:',& typefileini,typefileout,typefilelog - IF(varnames/='default')WRITE(unitterm,*)'Varnames:',varnames - IF(snapshotini>0)WRITE(unitterm,*)'Snapshotini:',snapshotini - IF(snapshotout>0)WRITE(unitterm,*)'Snapshotout:',snapshotout - WRITE(unitterm,*)'Fullgridini,out:',fullgridini,fullgridout - ENDIF + if(varnames/='default')write(unitterm,*)'Varnames:',varnames + if(snapshotini>0)write(unitterm,*)'Snapshotini:',snapshotini + if(snapshotout>0)write(unitterm,*)'Snapshotout:',snapshotout + write(unitterm,*)'Fullgridini,out:',fullgridini,fullgridout + endif - CALL readfileini(w) + call readfileini(w) ! Default for output header line fileheadout=fileheadini {^IFMPI ! Reset global test cell indexes to local ones - IF(globalixtest)CALL mpiix(ixtest^D,ipetest) + if(globalixtest)call mpiix(ixtest^D,ipetest) } - READ(unitpar,savelist) - DO ifile=1,nfile - IF(dtsave(ifile)0 if error - INTEGER:: ndimini,neqparini,neqparin,nwini,nwin ! values describing input data - INTEGER:: ix^L,idim,iw,ieqpar,snapshot - REAL(kind=8):: eqparextra - CHARACTER(^LENNAME) :: varnamesini + logical:: fileexist + integer:: ios ! 0 if not EOF, -1 if EOF, >0 if error + integer:: ndimini,neqparini,neqparin,nwini,nwin ! values describing input data + integer:: ix^L,idim,iw,ieqpar,snapshot + real(kind=8):: eqparextra + character(^LENNAME) :: varnamesini !----------------------------------------------------------------------------- - oktest=INDEX(teststr,'readfileini')>=1 + oktest=index(teststr,'readfileini')>=1 - IF(oktest) WRITE(unitterm,*)'ReadFileIni' + if(oktest) write(unitterm,*)'ReadFileIni' - INQUIRE(file=filenameini,exist=fileexist) - IF(.NOT.fileexist) CALL die('Stop: file does not exist, filenameini='//& + inquire(file=filenameini,exist=fileexist) + if(.not.fileexist) call die('Stop: file does not exist, filenameini='//& filenameini) - OPEN(unitini,file=filenameini,status='old',form='unformatted') + open(unitini,file=filenameini,status='old',form='unformatted') snapshot=0 - DO + do ! Read filehead - READ(unitini,iostat=ios) fileheadini !END=100 + read(unitini,iostat=ios) fileheadini !END=100 - IF(ios<0)EXIT ! Cycle until the last recorded state - IF(oktest) WRITE(unitterm,*)'fileheadini=',fileheadini(1:30) + if(ios<0)exit ! Cycle until the last recorded state + if(oktest) write(unitterm,*)'fileheadini=',fileheadini(1:30) ! Read params - READ(unitini,iostat=ios)it,t,ndimini,neqparini,nwini - IF(oktest) WRITE(unitterm, & + read(unitini,iostat=ios)it,t,ndimini,neqparini,nwini + if(oktest) write(unitterm, & "('it=',i7,' t=',g10.3,' ndim=',i3,' neqpar=',i3,' nw=',i3)")& it,t,ndimini,neqparini,nwini gencoord= ndimini<0 ! Validate parameters? - CALL checkNdimNeqparNw(ndimini,neqparini,nwini,neqparin,nwin) + call checkNdimNeqparNw(ndimini,neqparini,nwini,neqparin,nwin) ! Read nx - READ(unitini,iostat=ios)nx - IF(oktest) WRITE(unitterm,"('nx =',3i4)")nx + read(unitini,iostat=ios)nx + if(oktest) write(unitterm,"('nx =',3i4)")nx ! This set's up the global indicies based on nx and also ! deals with the MPI indicies etc. - CALL setixGixMix(ix^L) + call setixGixMix(ix^L) ! Read eqpar - READ(unitini,iostat=ios)(eqpar(ieqpar),ieqpar=1,neqparin),& + read(unitini,iostat=ios)(eqpar(ieqpar),ieqpar=1,neqparin),& (eqparextra,ieqpar=neqparin+1,neqparini) - IF(oktest) WRITE(unitterm,*)eqpar + if(oktest) write(unitterm,*)eqpar ! Read varnamesini - READ(unitini,iostat=ios)varnamesini - IF(varnames=='default')varnames=varnamesini - IF(oktest) WRITE(unitterm,*)varnames + read(unitini,iostat=ios)varnamesini + if(varnames=='default')varnames=varnamesini + if(oktest) write(unitterm,*)varnames ! Read x array - READ(unitini,iostat=ios)(x(ix^S,idim),idim=1,ndim) + read(unitini,iostat=ios)(x(ix^S,idim),idim=1,ndim) ! Read w array ! To conform savefileout_bin we use loop for iw - DO iw=1,nwin - READ(unitini,iostat=ios)w(ix^S,iw) - END DO - IF(ios/=0)THEN - WRITE(uniterr,*)'Error in ReadFileIni: iostat=',ios - CALL die('Error in reading file') - END IF + do iw=1,nwin + read(unitini,iostat=ios)w(ix^S,iw) + end do + if(ios/=0)then + write(uniterr,*)'Error in ReadFileIni: iostat=',ios + call die('Error in reading file') + end if snapshot=snapshot+1 - IF(snapshot==snapshotini)EXIT - END DO + if(snapshot==snapshotini)exit + end do !100 CONTINUE - CLOSE(unitini) + close(unitini) - IF(oktest) WRITE(*,*)'x,w:',& + if(oktest) write(*,*)'x,w:',& x(ixtest^D,idimtest),w(ixtest^D,iwtest) - IF(oktest) WRITE(*,*)'x,w:',& + if(oktest) write(*,*)'x,w:',& x(ixtest^D,idimtest),w(ixtest^D,1:nw) - RETURN -END SUBROUTINE readfileini_bin + return +end subroutine readfileini_bin subroutine readfileini_gdf(w) use gdf, only: gdf_parameters_T, gdf_root_datasets_T, gdf_field_type_T use hdf5, only: h5open_f, h5gopen_f, h5fopen_f, h5fclose_f, h5close_f, HID_T, H5F_ACC_RDONLY_F - use sacgdf, only: sacgdf_read_file, build_x_array - use gdf_datasets, only: read_dataset + use sacgdf, only: sacgdf_read_file, build_x_array, sacgdf_read_datasets + use gdf_datasets, only: read_real_dataset use common_variables, only: ixGlo^D, ixGhi^D, nw, filenameini, nx, x, t, gencoord, fileheadini implicit none - real(kind=8), intent(in) :: w(ixG^T,nw) + real(kind=8), intent(inout) :: w(ixG^T,nw) integer(kind=4) :: error - integer(HID_T) :: file_id, grid_g_id, grid_z_id + integer(HID_T) :: file_id, grid_g_id, grid_z_id, plist_id type(gdf_parameters_T) :: gdf_sp type(gdf_root_datasets_T) :: gdf_rd type(gdf_field_type_T), dimension(:), allocatable :: field_types character(len=60) :: software_name, software_version - class(*), dimension(:, :, :), pointer :: r_ptr + !class(*), dimension(:, :, :), pointer :: r_ptr real(kind=8), dimension(:, :, :), allocatable, target :: wdata3D integer:: ndimini,neqparini,neqparin,nwini,nwin ! values describing input data @@ -844,91 +845,87 @@ subroutine readfileini_gdf(w) ! Create field groups call h5gopen_f(file_id, "data", grid_g_id, error) !Create /data call h5gopen_f(grid_g_id, "grid_0000000000", grid_z_id, error) !Create the top grid - - r_ptr => wdata3D - call read_dataset(grid_z_id, 'internal_energy_pert', r_ptr) - print*, shape(wdata3D) - print*, wdata3D(50,50,1) - + call sacgdf_read_datasets(grid_z_id, plist_id, w, ix^L) + ! Close the file and interface call h5fclose_f(file_id, error) call h5close_f(error) end subroutine readfileini_gdf !============================================================================= -SUBROUTINE checkNdimNeqparNw(ndimini,neqparini,nwini,neqparin,nwin) +subroutine checkNdimNeqparNw(ndimini,neqparini,nwini,neqparin,nwin) - USE constants - USE common_variables + use constants + use common_variables - INTEGER:: ndimini,neqparini,nwini,neqparin,nwin + integer:: ndimini,neqparini,nwini,neqparin,nwin !----------------------------------------------------------------------------- - IF(ndim/=ABS(ndimini))THEN - WRITE(*,*)'Error in ReadFileini: ndimini=',ndimini - CALL die('Incompatible dimensionalities') - ENDIF + if(ndim/=abs(ndimini))then + write(*,*)'Error in ReadFileini: ndimini=',ndimini + call die('Incompatible dimensionalities') + endif - IF(neqpar+nspecialpar/=neqparini)WRITE(*,"(a,i3,a,i3)")& + if(neqpar+nspecialpar/=neqparini)write(*,"(a,i3,a,i3)")& 'Warning in ReadFileini: number of eq.params=',neqpar,& ' /= neqparini=',neqparini - IF(nw/=nwini)WRITE(*,"(a,i3,a,i3)")& + if(nw/=nwini)write(*,"(a,i3,a,i3)")& 'Warning in ReadFileini: number of variables nw=',nw,& ' /= nwini=',nwini - IF((neqpar+nspecialpar/=neqparini.OR.nw/=nwini).AND.varnames=='default')& - CALL die('Define varnames (in &filelist for VAC, in 3rd line for VACINI)!') + if((neqpar+nspecialpar/=neqparini.or.nw/=nwini).and.varnames=='default')& + call die('Define varnames (in &filelist for VAC, in 3rd line for VACINI)!') ! The number of equation parameters and variables to be read - neqparin=MIN(neqparini,neqpar+nspecialpar) - nwin=MIN(nwini,nw) + neqparin=min(neqparini,neqpar+nspecialpar) + nwin=min(nwini,nw) - RETURN -END SUBROUTINE checkNdimNeqparNw + return +end subroutine checkNdimNeqparNw !============================================================================= -SUBROUTINE setixGixMix(ix^L) +subroutine setixGixMix(ix^L) - USE constants - USE common_variables + use constants + use common_variables - INTEGER:: ix^L,qnx^IFMPI + integer:: ix^L,qnx^IFMPI !----------------------------------------------------------------------------- ixGmin^D=ixGlo^D; ixMmin^D=ixGmin^D+dixBmin^D; ! Shave off ghost cells from nx - IF(fullgridini)THEN + if(fullgridini)then {^DLOOP - IF(ipe^D==0)^IFMPI nx(^D)=nx(^D)-dixBmin^D - IF(ipe^D==npe^D-1)^IFMPI nx(^D)=nx(^D)-dixBmax^D + if(ipe^D==0)^IFMPI nx(^D)=nx(^D)-dixBmin^D + if(ipe^D==npe^D-1)^IFMPI nx(^D)=nx(^D)-dixBmax^D \} - ENDIF + endif ! Calculate mesh and grid sizes ixMmax^D=ixMmin^D+nx(^D)-1; ixGmax^D=ixMmax^D+dixBmax^D; ! Set the index range for this grid - IF(fullgridini)THEN + if(fullgridini)then ix^L=ixG^L; {^IFMPI ! Set index range to mesh value if the boundary is not an outer bounary - ^D&IF(ipe^D>0)ixmin^D=ixMmin^D\ - ^D&IF(ipe^D0)ixmin^D=ixMmin^D\ + ^D&if(ipe^DixGhi^D|.OR.)THEN - WRITE(uniterr,*)'Stop: nxhi=',ixGhi^D-dixBmax^D-ixMmin^D+1 - CALL die('Error in SetixGixMix') - END IF + if(ixGmax^D>ixGhi^D|.or.)then + write(uniterr,*)'Stop: nxhi=',ixGhi^D-dixBmax^D-ixMmin^D+1 + call die('Error in SetixGixMix') + end if nx^D=nx(^D); @@ -936,84 +933,84 @@ SUBROUTINE setixGixMix(ix^L) ! set global grid size by adding up nx and ! dividing by the number of processors in the orthogonal plane {^DLOOP - CALL MPI_allreduce(nx^D,nxall^D,1,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,ierrmpi) + call MPI_allreduce(nx^D,nxall^D,1,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,ierrmpi) nxall^D=nxall^D*npe^D/npe; \} ! Distribute global grid onto processor cube - CALL mpigridsetup + call mpigridsetup } - RETURN -END SUBROUTINE setixGixMix + return +end subroutine setixGixMix !============================================================================= -SUBROUTINE setheaderstrings +subroutine setheaderstrings ! Check and/or put physics and equation parameter names into file header - USE constants - USE common_variables + use constants + use common_variables - INTEGER:: i - CHARACTER(^LENTYPE) :: physics + integer:: i + character(^LENTYPE) :: physics !----------------------------------------------------------------------------- ! Check physics or add _typephysNDIMNDIR - WRITE(physics,'(a,i1,i1)')typephys,^ND,^NC - - i=INDEX(fileheadout,'_') - IF(i>=1)THEN - IF(physics/=fileheadout(i+1:i+^LENTYPE))THEN - WRITE(*,*)'This code is configured to ',physics - CALL die('Error: physics in file is '//fileheadout(i+1:i+^LENTYPE)) - ENDIF - ELSE - i=^LENNAME-LEN(typephys)-3 - DO - IF(fileheadout(i:i)/=' ' .OR. i==1)EXIT + write(physics,'(a,i1,i1)')typephys,^ND,^NC + + i=index(fileheadout,'_') + if(i>=1)then + if(physics/=fileheadout(i+1:i+^LENTYPE))then + write(*,*)'This code is configured to ',physics + call die('Error: physics in file is '//fileheadout(i+1:i+^LENTYPE)) + endif + else + i=^LENNAME-len(typephys)-3 + do + if(fileheadout(i:i)/=' ' .or. i==1)exit i=i-1 - ENDDO + enddo fileheadout=fileheadout(1:i)//'_'//physics - WRITE(*,*)'Warning: incomplete input headline.',& + write(*,*)'Warning: incomplete input headline.',& ' Added to output headline _',physics - ENDIF + endif ! Check for equation parameter names in varnames, add them if missing - IF(varnames/='default' .AND. INDEX(varnames,eqparname)<=0)THEN - i=^LENNAME-LEN(eqparname)-3 - DO - IF(varnames(i:i)/=' ' .OR. i==1)EXIT + if(varnames/='default' .and. index(varnames,eqparname)<=0)then + i=^LENNAME-len(eqparname)-3 + do + if(varnames(i:i)/=' ' .or. i==1)exit i=i-1 - ENDDO + enddo varnames=varnames(1:i)//' '//eqparname - ENDIF + endif ! Check for special equation parameter names in varnames, add them if missing - IF(varnames/='default' .AND. INDEX(varnames,specialparname)<=0)THEN - i=^LENNAME-LEN(specialparname)-3 - DO - IF(varnames(i:i)/=' ' .OR. i==1)EXIT + if(varnames/='default' .and. index(varnames,specialparname)<=0)then + i=^LENNAME-len(specialparname)-3 + do + if(varnames(i:i)/=' ' .or. i==1)exit i=i-1 - ENDDO + enddo varnames=varnames(1:i)//' '//specialparname - ENDIF + endif - RETURN -END SUBROUTINE setheaderstrings + return +end subroutine setheaderstrings !============================================================================= -SUBROUTINE savefile(ifile,w) +subroutine savefile(ifile,w) - USE constants - USE common_variables + use constants + use common_variables - INTEGER:: ifile,ix^L - REAL(kind=8):: w(ixG^T,nw) - CHARACTER(10):: itstring + integer:: ifile,ix^L + real(kind=8):: w(ixG^T,nw) + character(10):: itstring !----------------------------------------------------------------------------- !if(nproc(ifile+2)>0) call process(ifile+2,1,ndim,w) @@ -1021,142 +1018,142 @@ SUBROUTINE savefile(ifile,w) ! In most cases the mesh should be saved ix^L=ixM^L; - SELECT CASE(ifile) - CASE(fileout_) + select case(ifile) + case(fileout_) ! Produce the output file name filenameout=filename(fileout_) - IF(snapshotout>0.AND.isaveout>0)THEN - IF(isaveout==snapshotout*(isaveout/snapshotout))THEN - CLOSE(unitini+ifile) - WRITE(itstring,'(i10)')isaveout+1 - filenameout=filenameout(1:INDEX(filenameout,' ')-1)//'_'// & - itstring(10-INT(alog10(isaveout+1.5)):10) - ENDIF - ENDIF + if(snapshotout>0.and.isaveout>0)then + if(isaveout==snapshotout*(isaveout/snapshotout))then + close(unitini+ifile) + write(itstring,'(i10)')isaveout+1 + filenameout=filenameout(1:index(filenameout,' ')-1)//'_'// & + itstring(10-int(alog10(isaveout+1.5)):10) + endif + endif isaveout=isaveout+1 - IF(fullgridout)THEN + if(fullgridout)then ix^L=ixG^L; {^IFMPI ! Set index range to mesh value if not an outer boundary - ^D&IF(ipe^D>0)ixmin^D=ixMmin^D\ - ^D&IF(ipe^D0)ixmin^D=ixMmin^D\ + ^D&if(ipe^D5.0d-16) + where(abs(w(ix^D,1:nw))>5.0d-16) qw(1:nw)=w(ix^D,1:nw) - ELSEWHERE + elsewhere qw(1:nw)=0d0 - END WHERE - WRITE(qunit,"(100(1pe18.10))")x(ix^D,1:ndim),qw(1:nw) -ENDDO^D&; + end where + write(qunit,"(100(1pe18.10))")x(ix^D,1:ndim),qw(1:nw) +enddo^D&; -CALL flushunit(qunit) +call flushunit(qunit) -RETURN -END SUBROUTINE savefileout_asc +return +end subroutine savefileout_asc !============================================================================= -SUBROUTINE savefileout_bin(qunit,w,ix^L) +subroutine savefileout_bin(qunit,w,ix^L) ! This version saves into filename(fileout_) binary data at every save time ! in full accordance with the ReadFileini subroutine, except that the first ! line is fileheadout and not fileheadini. - USE constants - USE common_variables + use constants + use common_variables - INTEGER:: qunit,ix^L,idim,iw,ndimout - REAL(kind=8):: w(ixG^T,nw) - LOGICAL:: fileopen + integer:: qunit,ix^L,idim,iw,ndimout + real(kind=8):: w(ixG^T,nw) + logical:: fileopen !**************** slice - INTEGER:: s_ixmax^D, prom_ixmax^D, s_ixmin^D, prom_ixmin^D + integer:: s_ixmax^D, prom_ixmax^D, s_ixmin^D, prom_ixmin^D !**************** endslice !----------------------------------------------------------------------------- - INQUIRE(qunit,opened=fileopen) - IF(.NOT.fileopen)& - OPEN(qunit,file=filenameout,status='unknown',form='unformatted') + inquire(qunit,opened=fileopen) + if(.not.fileopen)& + open(qunit,file=filenameout,status='unknown',form='unformatted') - IF(gencoord)THEN + if(gencoord)then ndimout= -ndim - ELSE + else ndimout= ndim - ENDIF + endif - WRITE(qunit)fileheadout - WRITE(qunit)it,t,ndimout,neqpar+nspecialpar,nw - WRITE(qunit) ixmax^D-ixmin^D+1 - WRITE(qunit)eqpar - WRITE(qunit)varnames - WRITE(qunit)(x(ix^S,idim),idim=1,ndim) + write(qunit)fileheadout + write(qunit)it,t,ndimout,neqpar+nspecialpar,nw + write(qunit) ixmax^D-ixmin^D+1 + write(qunit)eqpar + write(qunit)varnames + write(qunit)(x(ix^S,idim),idim=1,ndim) ! write(qunit)w(ix^S,1:nw) produces segmentation fault on Alpha, thus loop - DO iw=1,nw - WRITE(qunit)w(ix^S,iw) - END DO + do iw=1,nw + write(qunit)w(ix^S,iw) + end do - CALL flushunit(qunit) + call flushunit(qunit) !**************** slice ********************************* @@ -1194,30 +1191,30 @@ SUBROUTINE savefileout_bin(qunit,w,ix^L) !************* end slice ********************************** - RETURN -END SUBROUTINE savefileout_bin + return +end subroutine savefileout_bin !============================================================================= -SUBROUTINE savefileout_gdf(w,ix^L) +subroutine savefileout_gdf(w,ix^L) - USE hdf5 + use hdf5 use gdf use sacgdf use gdf_datasets, only: write_dataset - USE common_variables + use common_variables - IMPLICIT NONE + implicit none - INTEGER, INTENT(IN) :: ix^L - REAL(kind=8), INTENT(IN):: w(ixG^T,nw) + integer, intent(IN) :: ix^L + real(kind=8), intent(IN):: w(ixG^T,nw) - INTEGER(HID_T) :: file_id + integer(HID_T) :: file_id integer(HID_T) :: plist_id !< Property list identifier integer(HID_T) :: doml_g_id !< domain list identifier integer(HID_T) :: dom_g_id !< domain group identifier - INTEGER :: error + integer :: error character(len=8) :: itstr @@ -1236,13 +1233,13 @@ SUBROUTINE savefileout_gdf(w,ix^L) allocate(wdata3D(1:gdf_nx(1), 1:gdf_nx(2), 1:gdf_nx(3))) ! Open file - CALL h5open_f(error) + call h5open_f(error) ! Create a property access list (for MPI later on) call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, error) ! Create the file ! Convert the current iteration to a string write(itstr, '(I8.8)') int(it) - call h5fcreate_f(TRIM(filenameout)//itstr//'.gdf', H5F_ACC_TRUNC_F, file_id, error, access_prp=plist_id) + call h5fcreate_f(trim(filenameout)//itstr//'.gdf', H5F_ACC_TRUNC_F, file_id, error, access_prp=plist_id) ! Create ! Simulation Parameters @@ -1282,13 +1279,13 @@ SUBROUTINE savefileout_gdf(w,ix^L) ! WRITE ACTUAL DATA HERE call sacgdf_write_datasets(doml_g_id, plist_id, w, ix^L) - CALL h5fclose_f(file_id, error) - CALL h5close_f(error) + call h5fclose_f(file_id, error) + call h5close_f(error) -END SUBROUTINE savefileout_gdf +end subroutine savefileout_gdf !============================================================================= -SUBROUTINE savefilelog_default(qunit,w,ix^L) +subroutine savefilelog_default(qunit,w,ix^L) ! This version saves into filename(filelog_) the following formatted data: ! @@ -1302,67 +1299,67 @@ SUBROUTINE savefilelog_default(qunit,w,ix^L) ! at every save time. wmean is the volume averaged w, residual is saved ! if residmin>0 is set in the parfile. - USE constants - USE common_variables + use constants + use common_variables - INTEGER:: qunit,ix^L - REAL(kind=8):: w(ixG^T,nw) - INTEGER:: iw - LOGICAL:: fileopen - REAL(kind=8):: wmean(nw) + integer:: qunit,ix^L + real(kind=8):: w(ixG^T,nw) + integer:: iw + logical:: fileopen + real(kind=8):: wmean(nw) !----------------------------------------------------------------------------- - IF(ipe==0)THEN^IFMPI + if(ipe==0)then^IFMPI - INQUIRE(qunit,opened=fileopen) - IF(.NOT.fileopen)THEN - OPEN(qunit,file=filename(filelog_),status='unknown') - WRITE(qunit,'(a)')fileheadout - IF(residmin>zero.OR.residmaxzero.or.residmaxzero.OR.residmaxzero.or.residmax Date: Wed, 10 Sep 2014 15:47:04 +0100 Subject: [PATCH 12/32] getting closer to it actually working. It seems at this point that the bug is not in the dataset reading (as this appears to be working, giving the same means as python), it seems that the non-fullini read is also not working with the binary input. --- sac/par/binout | 51 +++++++++++++++++++++++++++++++++++++++++++++++++ sac/par/gdfini | 4 ++-- sac/src/vacio.t | 15 ++++++++++++++- 3 files changed, 67 insertions(+), 3 deletions(-) create mode 100644 sac/par/binout diff --git a/sac/par/binout b/sac/par/binout new file mode 100644 index 0000000..dd26039 --- /dev/null +++ b/sac/par/binout @@ -0,0 +1,51 @@ +&testlist + teststr='readfileini' +/ + +&filelist + filenameini='/archive/mhdmodes_2D.out' + + typefileini='binary' + filename= '/archive/mhdmodes_2D.log', + '/archive/mhdmodes_2D.out' + typefileout='binary' + fullgridout= F + fullgridini= F + / + +&savelist + itsave(1,2)=0 + + / + + &stoplist + tmax=0.2d0 + itmax = 10000 + / + + &methodlist + + wnames= 'h m1 m2 e b1 b2 eb rhob bg1 bg2' + typefull= 6*'cd4',4*'nul' + typeadvance= 'onestep' + typefilter= 10*'nul' + dimsplit= F + sourcesplit= F + divBfix= F + smallp= 10.d0 + / + + &boundlist + typeB= 10*'fixed' + 10*'fixed' + 10*'fixed' + 10*'fixed' + 10*'fixed' + 10*'fixed' + + / + + ¶mlist + courantpar=0.2 + + / diff --git a/sac/par/gdfini b/sac/par/gdfini index fa67609..a435d6e 100644 --- a/sac/par/gdfini +++ b/sac/par/gdfini @@ -1,5 +1,5 @@ &testlist - teststr='readfileini' + teststr='readfileini readparameters' / &filelist @@ -10,7 +10,7 @@ '/archive/mhdmodes_2D' typefileout='gdf' fullgridout= F - fullgridini= T + fullgridini= F / &savelist diff --git a/sac/src/vacio.t b/sac/src/vacio.t index 028499c..daaf3cb 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -211,6 +211,7 @@ subroutine readparameters(w) endif call readfileini(w) + print*, "back in readparams" ! Default for output header line fileheadout=fileheadini @@ -531,6 +532,8 @@ subroutine readparameters(w) call setheaderstrings + print*, "end readparameters" + return end subroutine readparameters @@ -592,6 +595,7 @@ subroutine readfileini(w) call die('Error in VAC: Unknown typefileini='//typefileini) end select + print*, "out readini" return end subroutine readfileini @@ -739,6 +743,10 @@ subroutine readfileini_bin(w) ! deals with the MPI indicies etc. call setixGixMix(ix^L) + print*, "____________________________________" + print*, "nx", nx + print*, "ix", ix^L + ! Read eqpar read(unitini,iostat=ios)(eqpar(ieqpar),ieqpar=1,neqparin),& (eqparextra,ieqpar=neqparin+1,neqparini) @@ -783,7 +791,7 @@ subroutine readfileini_gdf(w) use hdf5, only: h5open_f, h5gopen_f, h5fopen_f, h5fclose_f, h5close_f, HID_T, H5F_ACC_RDONLY_F use sacgdf, only: sacgdf_read_file, build_x_array, sacgdf_read_datasets use gdf_datasets, only: read_real_dataset - use common_variables, only: ixGlo^D, ixGhi^D, nw, filenameini, nx, x, t, gencoord, fileheadini + use common_variables, only: ixGlo^D, ixGhi^D, nw, filenameini, nx, x, t, gencoord, fileheadini, rhob_ implicit none @@ -848,6 +856,11 @@ subroutine readfileini_gdf(w) call sacgdf_read_datasets(grid_z_id, plist_id, w, ix^L) + print*, "Do some value tests" + print*, ix^L + print*, shape(w) + print*, "density_bg", sum(w(ix^S, rhob_)) + ! Close the file and interface call h5fclose_f(file_id, error) call h5close_f(error) From 0e8601cffd87e6d5701b43a893d11bd2634e103c Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Thu, 11 Sep 2014 10:49:45 +0100 Subject: [PATCH 13/32] Bit of a tidy up. Why is SAC not running when no ghost cells are specified?! --- .gitignore | 2 + sac/binini | Bin 0 -> 5633 bytes sac/gdfini | 114 +++++++++++++++++++++++++++++++++++++++++++++++ sac/src/Makefile | 2 +- sac/src/fgdfio | 2 +- sac/src/sacgdf.t | 38 ++++++++-------- sac/src/vacio.t | 12 ++++- sac/vac.par | 1 - 8 files changed, 148 insertions(+), 23 deletions(-) create mode 100644 .gitignore create mode 100644 sac/binini create mode 100644 sac/gdfini delete mode 120000 sac/vac.par diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..2f32fc0 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*.mod +*.o diff --git a/sac/binini b/sac/binini new file mode 100644 index 0000000000000000000000000000000000000000..8b8cfb3927f512375a9a69a850f2cb76e92c8905 GIT binary patch literal 5633 zcmeGgO>g5=ut@BomNk|0l5}l1?KYJxt!q15BYy_VCd0OhVC%TOK-B1MGqC-l=-B(YM$KSV3TK^MwXr5pBw=}AfgNvw3b zrSSvy-RmjCPN~;POX+F%q({G{XgE44jgn|GN#YVx`eEEjk}=AJlW3BbhNDOTFATc1 z=p-~_1bX-}KtvQrimV@_O;-)AvIPOM6gk^}shofMOpF0pgQa}=g z_zV!N?$DnA$ImeYK$+PfNj^wJv_OL`PQiKMySh8aS9j4>AZ_mCqnZ!SL3>ypFNY#s zZbyJK_!tH-lwc@B2yF@4IJaRuNZQcuBiN_Y=m*1L0AU)?_c%C}*zYChw02`H8{dBU z=g*HmU0ZuChxx=|QT>b2-dxt`(0uYUdR8Op=&!^b28Is9R#^ds?g-n>iG z+A|z9|FAcGO!kicc*5oE$zD&)HLft>?Gze`4&qsI$4~ z=j>sZk>J){Hh=U@rniV+dHuxB5XG@)33I!`%sjXP1 zAa+sP*5zfs*p2|nG=*_?{|e9!Iu9U<83J$8U^o%rFc`;C+$S_$+;u{SX*izjfs?=_ zI1Q<>=tgOj#L!E|>_$h6vmpuK+v*YC!&!-1Iz@@G31D&-f+b=>srz+f|6P!7F&@C1 zyceBe^Frh0ea-C3ugLD!E3#YpukC_y!RX zSjXmMJzQ@~>usFd>(rdAV{?Lkm$V>xuv}07z6S)TnU-;2sJh$qujtnQvGt z9uUCzpssqDO$G0b5>z${ZEtO^j*ddm(im2)>)zJ(kiNi@6j*yh$YfZ~iU}vM# zt?)CiY{b)(9LSjJo}tr&Y$Jb6&ZJGdj?zdtFM*Nf8@QQENS0}voHmT&VZyG2%#h*u zo?E|vK`zH@u2EB%8?aYqL$2Fo%t z)inm_rroGprq2LsLuQC+JQau_b@va%ROxPM!m5R&?1`S zamLimHd)Cj47*|}Bt2Wq#lzdh!;`jhU54kmbQ@fVgjrc9ZJuFaZ(bJ9zpmyRV>S<2 zsk$s+?ilZh)!p1C2BnXMZoX%k?>VQ)a}sRlLRm4-eSy9I0@|Ssx zo=&p&Kvwt|fo_J=pmW@gI(=R{iD0YC0)%snLmvwz&wt7~!)wi9yfqBExi|yzlNt`P zTa5!-meDe-8SQ;ltEr7SZ&nysg5MS(jJxwk7JE$zjWigipmtA#xWlVF9i0S|up`v) W|D%(^GMT9I0u^0>S;pNpr~VCr$CX6@ literal 0 HcmV?d00001 diff --git a/sac/gdfini b/sac/gdfini new file mode 100644 index 0000000..f1bbbd8 --- /dev/null +++ b/sac/gdfini @@ -0,0 +1,114 @@ +VAC 4.52 configured to + -d=22 -phi=0 -z=0 -g=104,104 -p=mhd -u=default + -on=cd,rk + -off=mc,fct,tvdlf,tvd,impl,poisson,ct,gencoord,resist,mpi + ReadParameters +&TESTLIST + TESTSTR=readfileini readparameters + IXTEST1= 3, + IXTEST2= 3, + IXTEST3= 3, + IWTEST= 1, + IDIMTEST= 1, + / + /archive/mhdmodes_2D_ini.gdf + /archive/mhdmodes_2D.log + /archive/mhdmodes_2D + Type of ini/out and log files:gdf gdf default + Fullgridini,out: F F + /archive/mhdmodes_2D_ini.gdf + Do some value tests + 3 3 98 98 + 104 104 10 + density_bg 9216.0000000000000 + out readini + back in readparams + DTSAVE for file 1 =1.0000 + DTSAVE for file 2 =.10000 + TMAX= 0.20000000000000001 + ITMAX= 10000 + TYPEB( 1) = fixed fixed fixed fixed fixed fixed fixed fixed fixed fixed + TYPEB( 2) = fixed fixed fixed fixed fixed fixed fixed fixed fixed fixed + TYPEB( 3) = fixed fixed fixed fixed fixed fixed fixed fixed fixed fixed + TYPEB( 4) = fixed fixed fixed fixed fixed fixed fixed fixed fixed fixed + EXTRAB = F +&METHODLIST + WNAMES=h m1 m2 e b1 b2 eb rhob bg1 bg2 + FILEHEADOUT=gdf + EQPAR= 6*0.0000000000000000 , + TYPEADVANCE=onestep + TYPEFULL= 6*cd4 4*nul + TYPEPRED= 10*default + TYPEIMPL= 10*nul + TYPEFILTER= 10*nul + TYPELIMITER= 10*minmod + TYPEENTROPY= 10*nul + ENTROPYCOEF= 4*0.20000000298023224 , 2*-1.0000000000000000 , 2*0.40000000596046448 , 2*-1.0000000000000000 , + ARTCOMP= 10*F, + TYPELIMITED=previous + TYPEFCT=etbfct + TYPETVD=roe + TYPEAXIAL=slab + TYPEPOISSON=default + TYPECONSTRAIN=nul + CONSTRAINCOEF= 1.0000000000000000 , + USEPRIMITIVE=F, + MUSCLETA= 0.0000000000000000 , + MUSCLOMEGA= 0.0000000000000000 , + ACMWIDTH= 1, + ACMNOLIM=F, + ACMCOEF= 10*-1.0000000000000000 , + ACMEXPO= 0.0000000000000000 , + FOURTHORDER=F, + IMPLMRPC=F, + DIMSPLIT=F, + TYPEDIMSPLIT=unsplit + SOURCESPLIT=F, + TYPESOURCESPLIT=unsplit + SOURCEUNSPLIT=T, + DIVBFIX=F, + DIVBWAVE=T, + DIVBCONSTRAIN=F, + ANGMOMFIX=F, + COMPACTRES=F, + SMALLFIX=F, + SMALLP= 10.000000000000000 , + SMALLPCOEFF= 9.9999999999999995E-007, + SMALLRHO= -1.0000000000000000 , + SMALLRHOCOEFF= 9.9999999999999995E-007, + VACUUMRHO= -1.0000000000000000 , + NPROC= 4*0 , + PROCPAR= 3*-1.0000000000000000 , + / +&PARAMLIST + COURANTPAR= 0.20000000000000001 , + DTPAR= -1.0000000000000000 , + DTDIFFPAR= 0.50000000000000000 , + DTCANTGROW=F, + SLOWSTEPS= 0, + IMPLMRPCPAR= 4, + IMPLPAR= -1.0000000000000000 , + IMPLDIFFPAR= 9.9999999999999998E-013, + IMPLERROR= 0.0000000000000000 , + IMPLRELAX=-0.50000000000000000 , + IMPLDWLIMIT= 9.9999999999999997E+098, + IMPLRESTART= 20, + IMPLRESTART2= 5, + IMPLITER= 100, + IMPLITERNR= 20, + TYPEIMPLINIT=unused + TYPEIMPLITER=vac_bicg + TYPEIMPLMAT=unused + IMPLNEWTON=F, + IMPLCONSERV=F, + IMPLCENTERED=F, + IMPLNEWMAT=F, + IMPLPRED=F, + IMPL3LEVEL=F, + IMPLJACFAST=F, + IMPLSOURCE=T, + / + Warning: incomplete input headline. Added to output headline _mhd22 + end readparameters +Start Advance 0.006 sec + Correct Getcsound2 for NONIDEAL gas in vacphys.t.mhd diff --git a/sac/src/Makefile b/sac/src/Makefile index 35da7a4..f74deec 100644 --- a/sac/src/Makefile +++ b/sac/src/Makefile @@ -29,7 +29,7 @@ GDFDIR=./fgdfio/lib LIBS = vacdef$F sacgdf$F INCLUDES = vacdef$F vacpar$F vacusrpar$F sacgdf$F -GDF_INCLUDES = $(GDFDIR)/gdf_types.F90 $(GDFDIR)/helpers_hdf5.F90 $(GDFDIR)/grid_data_format.F90 $(GDFDIR)/data_writers_beta.F90 +GDF_INCLUDES = $(GDFDIR)/gdf_types.F90 $(GDFDIR)/helpers_hdf5.F90 $(GDFDIR)/grid_data_format.F90 $(GDFDIR)/gdf_datasets.F90 VAC_FOR = vac$F vacio$F vacgrid$F vacphys0$F vacphys$F vacusr$F VAC_OBJ = vac$O vacio$O vacgrid$O vacphys0$O vacphys$O vacusr$O diff --git a/sac/src/fgdfio b/sac/src/fgdfio index c543cba..099afe5 160000 --- a/sac/src/fgdfio +++ b/sac/src/fgdfio @@ -1 +1 @@ -Subproject commit c543cba516e536b68b65e4e47c651dea0dd72a0f +Subproject commit 099afe5419623e08b2abb1ade53fa8a41975594d diff --git a/sac/src/sacgdf.t b/sac/src/sacgdf.t index 86a2147..eab3265 100644 --- a/sac/src/sacgdf.t +++ b/sac/src/sacgdf.t @@ -348,7 +348,7 @@ contains subroutine sacgdf_read_datasets_1D(place, plist_id, w, ix^L) use hdf5, only: HID_T - use gdf_datasets, only: read_real_dataset + use gdf_datasets, only: read_real8_dataset use common_variables, only: rho_, rhob_, e_, eb_, m1_, b1_, bg1_ use common_variables, only: ixGhi^D, ixGlo^D, nw, nx @@ -362,37 +362,37 @@ contains real(kind=8), dimension(:, :, :), allocatable :: wdata3D ! Density pert - call read_real_dataset(place, 'density_pert', wdata3D) + call read_real8_dataset(place, 'density_pert', wdata3D) w(ix^S, rho_) = reshape(wdata3D, nx) deallocate(wdata3D) ! Denisty bg - call read_real_dataset(place, 'density_bg', wdata3D) + call read_real8_dataset(place, 'density_bg', wdata3D) w(ix^S, rhob_) = reshape(wdata3D, nx) deallocate(wdata3D) ! Velocity - call read_real_dataset(place, 'velocity_x', wdata3D) + call read_real8_dataset(place, 'velocity_x', wdata3D) w(ix^S, m1_) = reshape(wdata3D, nx) * (w(ix^S, rho_) + w(ix^S, rhob_)) deallocate(wdata3D) ! internal energy pert - call read_real_dataset(place, 'internal_energy_pert', wdata3D) + call read_real8_dataset(place, 'internal_energy_pert', wdata3D) w(ix^S, e_) = reshape(wdata3D, nx) deallocate(wdata3D) ! internal energy bg - call read_real_dataset(place, 'internal_energy_bg', wdata3D) + call read_real8_dataset(place, 'internal_energy_bg', wdata3D) w(ix^S, eb_) = reshape(wdata3D, nx) deallocate(wdata3D) ! Mag field pert - call read_real_dataset(place, 'mag_field_x_pert', wdata3D) + call read_real8_dataset(place, 'mag_field_x_pert', wdata3D) w(ix^S, b1_) = reshape(wdata3D, nx) deallocate(wdata3D) ! Mag field bg - call read_real_dataset(place, 'mag_field_x_bg', wdata3D) + call read_real8_dataset(place, 'mag_field_x_bg', wdata3D) w(ix^S, bg1_) = reshape(wdata3D, nx) deallocate(wdata3D) @@ -401,7 +401,7 @@ contains {^IFTWOD subroutine sacgdf_read_datasets_2D(place, plist_id, w, ix^L) use hdf5, only: HID_T - use gdf_datasets, only: read_real_dataset + use gdf_datasets, only: read_real8_dataset use common_variables, only: rho_, rhob_, m2_, b2_, bg2_ use common_variables, only: ixGhi^D, ixGlo^D, nw, nx @@ -415,17 +415,17 @@ contains real(kind=8), dimension(:, :, :), allocatable :: wdata3D ! Velocity - call read_real_dataset(place, 'velocity_y', wdata3D) + call read_real8_dataset(place, 'velocity_y', wdata3D) w(ix^S, m2_) = reshape(wdata3D, nx) * (w(ix^S, rho_) + w(ix^S, rhob_)) deallocate(wdata3D) ! Mag field pert - call read_real_dataset(place, 'mag_field_y_pert', wdata3D) + call read_real8_dataset(place, 'mag_field_y_pert', wdata3D) w(ix^S, b2_) = reshape(wdata3D, nx) deallocate(wdata3D) ! Mag field bg - call read_real_dataset(place, 'mag_field_y_bg', wdata3D) + call read_real8_dataset(place, 'mag_field_y_bg', wdata3D) w(ix^S, bg2_) = reshape(wdata3D, nx) deallocate(wdata3D) @@ -434,7 +434,7 @@ contains {^IFTHREED subroutine sacgdf_read_datasets_3D(place, plist_id, w, ix^L) use hdf5, only: HID_T - use gdf_datasets, only: read_real_dataset + use gdf_datasets, only: read_real8_dataset use common_variables, only: rho_, rhob_, m3_, b3_, bg3_ use common_variables, only: ixGhi^D, ixGlo^D, nw, nx @@ -448,32 +448,32 @@ contains real(kind=8), dimension(:, :, :), allocatable :: wdata3D ! Velocity - call read_real_dataset(place, 'velocity_y', wdata3D) + call read_real8_dataset(place, 'velocity_y', wdata3D) w(ix^S, m2_) = reshape(wdata3D, nx) * (w(ix^S, rho_) + w(ix^S, rhob_)) deallocate(wdata3D) ! Mag field pert - call read_real_dataset(place, 'mag_field_y_pert', wdata3D) + call read_real8_dataset(place, 'mag_field_y_pert', wdata3D) w(ix^S, b2_) = reshape(wdata3D, nx) deallocate(wdata3D) ! Mag field bg - call read_real_dataset(place, 'mag_field_y_bg', wdata3D) + call read_real8_dataset(place, 'mag_field_y_bg', wdata3D) w(ix^S, bg2_) = reshape(wdata3D, nx) deallocate(wdata3D) ! Velocity - call read_real_dataset(place, 'velocity_z', wdata3D) + call read_real8_dataset(place, 'velocity_z', wdata3D) w(ix^S, m3_) = reshape(wdata3D, nx) * (w(ix^S, rho_) + w(ix^S, rhob_)) deallocate(wdata3D) ! Mag field pert - call read_real_dataset(place, 'mag_field_z_pert', wdata3D) + call read_real8_dataset(place, 'mag_field_z_pert', wdata3D) w(ix^S, b3_) = reshape(wdata3D, nx) deallocate(wdata3D) ! Mag field bg - call read_real_dataset(place, 'mag_field_z_bg', wdata3D) + call read_real8_dataset(place, 'mag_field_z_bg', wdata3D) w(ix^S, bg3_) = reshape(wdata3D, nx) deallocate(wdata3D) diff --git a/sac/src/vacio.t b/sac/src/vacio.t index daaf3cb..e293eb2 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -790,7 +790,6 @@ subroutine readfileini_gdf(w) use gdf, only: gdf_parameters_T, gdf_root_datasets_T, gdf_field_type_T use hdf5, only: h5open_f, h5gopen_f, h5fopen_f, h5fclose_f, h5close_f, HID_T, H5F_ACC_RDONLY_F use sacgdf, only: sacgdf_read_file, build_x_array, sacgdf_read_datasets - use gdf_datasets, only: read_real_dataset use common_variables, only: ixGlo^D, ixGhi^D, nw, filenameini, nx, x, t, gencoord, fileheadini, rhob_ implicit none @@ -1386,6 +1385,15 @@ end subroutine flushunit ! end module vacio !############################################################################## +!================================================================================ +!! The Following routines belong in the sacgdf.t file, however due to an apparent +!! bug in the gfortran 4.9.1 compiler they have to remain here. +!! Future compiler updates should be tested to check for correct behaviour when +!! compiling and running with these routines in the scgdf.t file. +!================================================================================ + +!================================================================================ + subroutine sacgdf_write_datasets(place, plist_id, w, ix^L) use hdf5, only: HID_T use gdf_datasets @@ -1583,5 +1591,7 @@ end subroutine flushunit end subroutine sacgdf_write_datasets_3D } +!================================================================================ +!================================================================================ diff --git a/sac/vac.par b/sac/vac.par deleted file mode 120000 index 4a96520..0000000 --- a/sac/vac.par +++ /dev/null @@ -1 +0,0 @@ -par/mhdmodes \ No newline at end of file From d4eccf46ae4e8a006884ba78181a339fe3baacd7 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Fri, 19 Sep 2014 17:09:49 +0100 Subject: [PATCH 14/32] Fix attribute read which fixes the old bug. There seems to now be other issues, firstly with gdfout. --- sac/par/binout | 8 ++--- sac/par/gdfini | 12 +++---- sac/par/gdfout | 12 +++---- sac/src/fgdfio | 2 +- sac/src/sacgdf.t | 77 ++++++++++++++++++++++-------------------- sac/src/vac.t | 5 --- sac/src/vacdef.t | 3 +- sac/src/vacio.t | 50 ++++++++++++++++----------- sac/src/vacphys0.t.mhd | 2 +- 9 files changed, 92 insertions(+), 79 deletions(-) diff --git a/sac/par/binout b/sac/par/binout index dd26039..43a5515 100644 --- a/sac/par/binout +++ b/sac/par/binout @@ -3,14 +3,14 @@ / &filelist - filenameini='/archive/mhdmodes_2D.out' + filenameini='/archive/gdf_testing/mhdmodes_2D.ini' typefileini='binary' - filename= '/archive/mhdmodes_2D.log', - '/archive/mhdmodes_2D.out' + filename= '/archive/gdf_testing/mhdmodes_2D.log', + '/archive/gdf_testing/mhdmodes_2D.out' typefileout='binary' fullgridout= F - fullgridini= F + fullgridini= T / &savelist diff --git a/sac/par/gdfini b/sac/par/gdfini index a435d6e..ed11c64 100644 --- a/sac/par/gdfini +++ b/sac/par/gdfini @@ -1,16 +1,16 @@ &testlist - teststr='readfileini readparameters' + teststr='readfileini readfileini_gdf' / &filelist - filenameini='/archive/mhdmodes_2D_ini.gdf' + filenameini='/archive/gdf_testing/mhdmodes_2D_00000000.gdf' typefileini='gdf' - filename= '/archive/mhdmodes_2D.log', - '/archive/mhdmodes_2D' + filename= '/archive/gdf_testing/mhdmodes_2D.log', + '/archive/gdf_testing/mhdmodes_2D_gdfini_' typefileout='gdf' - fullgridout= F - fullgridini= F + fullgridout= T + fullgridini= T / &savelist diff --git a/sac/par/gdfout b/sac/par/gdfout index 9ffa016..5060bbe 100644 --- a/sac/par/gdfout +++ b/sac/par/gdfout @@ -3,13 +3,13 @@ / &filelist - filenameini='/archive/io_testing/mhdmodes_2D.ini' + filenameini='/archive/gdf_testing/mhdmodes_2D.ini' typefileini='binary' - filename= '/archive/mhdmodes_2D.log', - '/archive/mhdmodes_2D' + filename= '/archive/gdf_testing/mhdmodes_2D.log', + '/archive/gdf_testing/mhdmodes_2D_' typefileout='gdf' - fullgridout= F + fullgridout= T fullgridini= T / @@ -26,9 +26,9 @@ &methodlist - wnames= 'h m1 m2 e b1 b2 eb rhob bg1 bg2' + wnames= 'h m1 m2 e b1 b2 eb rhob bg1 bg2' typefull= 6*'cd4',4*'nul' - typeadvance= 'onestep' + typeadvance= 'onestep' typefilter= 10*'nul' dimsplit= F sourcesplit= F diff --git a/sac/src/fgdfio b/sac/src/fgdfio index 099afe5..224ee15 160000 --- a/sac/src/fgdfio +++ b/sac/src/fgdfio @@ -1 +1 @@ -Subproject commit 099afe5419623e08b2abb1ade53fa8a41975594d +Subproject commit 224ee1554cc0861e7525a467b422b8bf0be0c4ce diff --git a/sac/src/sacgdf.t b/sac/src/sacgdf.t index eab3265..9ca7a52 100644 --- a/sac/src/sacgdf.t +++ b/sac/src/sacgdf.t @@ -3,6 +3,7 @@ module sacgdf contains + subroutine sacgdf_write_file(file_id, gdf_rd, gdf_sp, field_types) use hdf5, only: HID_T use gdf, only: gdf_write_file, gdf_root_datasets_T, gdf_parameters_T, gdf_field_type_T @@ -41,9 +42,6 @@ contains end subroutine sacgdf_read_file - - - subroutine sacgdf_write_eqpar(file_id) ! Convert simulation parameters to the eqpar array use common_variables @@ -264,32 +262,35 @@ contains call h5gopen_f(file_id, 'simulation_parameters', g_id, error) - r_ptr => eqpar(gamma_:gamma_) + allocate(r_ptr(1)) + call read_attribute(g_id, 'gamma', r_ptr) + eqpar(gamma_:gamma_) = r_ptr - r_ptr => eqpar(eta_:eta_) call read_attribute(g_id, 'eta', r_ptr) + eqpar(eta_:eta_) = r_ptr - r_ptr => eqpar(grav0_:grav0_) call read_attribute(g_id, 'gravity0', r_ptr) + eqpar(grav0_:grav0_) = r_ptr - r_ptr => eqpar(grav1_:grav1_) call read_attribute(g_id, 'gravity1', r_ptr) + eqpar(grav1_:grav1_) = r_ptr ! Read the extra parameters only if we are 2D or 3D {^IFTWOD - r_ptr => eqpar(grav2_:grav2_) call read_attribute(g_id, 'gravity2', r_ptr) + eqpar(grav2_:grav2_) = r_ptr } {^IFTHREED - r_ptr => eqpar(grav2_:grav2_) call read_attribute(g_id, 'gravity2', r_ptr) - r_ptr => eqpar(grav3_:grav3_) + eqpar(grav2_:grav2_) = r_ptr + call read_attribute(g_id, 'gravity3', r_ptr) + eqpar(grav3_:grav3_) = r_ptr } - r_ptr => eqpar(nu_:nu_) call read_attribute(g_id, 'nu', r_ptr) + eqpar(nu_:nu_) = r_ptr i4_ptr => it_arr call read_attribute(g_id, 'current_iteration', i4_ptr) @@ -331,6 +332,7 @@ contains use hdf5, only: HID_T use gdf_datasets use common_variables, only: ixGhi^D, ixGlo^D, nw + use phys_constants, only: mu0 implicit none @@ -348,9 +350,10 @@ contains subroutine sacgdf_read_datasets_1D(place, plist_id, w, ix^L) use hdf5, only: HID_T - use gdf_datasets, only: read_real8_dataset + use gdf_datasets, only: read_dataset use common_variables, only: rho_, rhob_, e_, eb_, m1_, b1_, bg1_ use common_variables, only: ixGhi^D, ixGlo^D, nw, nx + use phys_constants, only: mu0 implicit none @@ -362,38 +365,38 @@ contains real(kind=8), dimension(:, :, :), allocatable :: wdata3D ! Density pert - call read_real8_dataset(place, 'density_pert', wdata3D) + call read_dataset(place, 'density_pert', wdata3D) w(ix^S, rho_) = reshape(wdata3D, nx) deallocate(wdata3D) ! Denisty bg - call read_real8_dataset(place, 'density_bg', wdata3D) + call read_dataset(place, 'density_bg', wdata3D) w(ix^S, rhob_) = reshape(wdata3D, nx) deallocate(wdata3D) ! Velocity - call read_real8_dataset(place, 'velocity_x', wdata3D) + call read_dataset(place, 'velocity_x', wdata3D) w(ix^S, m1_) = reshape(wdata3D, nx) * (w(ix^S, rho_) + w(ix^S, rhob_)) deallocate(wdata3D) ! internal energy pert - call read_real8_dataset(place, 'internal_energy_pert', wdata3D) + call read_dataset(place, 'internal_energy_pert', wdata3D) w(ix^S, e_) = reshape(wdata3D, nx) deallocate(wdata3D) ! internal energy bg - call read_real8_dataset(place, 'internal_energy_bg', wdata3D) + call read_dataset(place, 'internal_energy_bg', wdata3D) w(ix^S, eb_) = reshape(wdata3D, nx) deallocate(wdata3D) ! Mag field pert - call read_real8_dataset(place, 'mag_field_x_pert', wdata3D) - w(ix^S, b1_) = reshape(wdata3D, nx) + call read_dataset(place, 'mag_field_x_pert', wdata3D) + w(ix^S, b1_) = reshape(wdata3D, nx)/sqrt(mu0) deallocate(wdata3D) ! Mag field bg - call read_real8_dataset(place, 'mag_field_x_bg', wdata3D) - w(ix^S, bg1_) = reshape(wdata3D, nx) + call read_dataset(place, 'mag_field_x_bg', wdata3D) + w(ix^S, bg1_) = reshape(wdata3D, nx)/sqrt(mu0) deallocate(wdata3D) end subroutine sacgdf_read_datasets_1D @@ -401,9 +404,10 @@ contains {^IFTWOD subroutine sacgdf_read_datasets_2D(place, plist_id, w, ix^L) use hdf5, only: HID_T - use gdf_datasets, only: read_real8_dataset + use gdf_datasets, only: read_dataset use common_variables, only: rho_, rhob_, m2_, b2_, bg2_ use common_variables, only: ixGhi^D, ixGlo^D, nw, nx + use phys_constants, only: mu0 implicit none @@ -415,18 +419,18 @@ contains real(kind=8), dimension(:, :, :), allocatable :: wdata3D ! Velocity - call read_real8_dataset(place, 'velocity_y', wdata3D) + call read_dataset(place, 'velocity_y', wdata3D) w(ix^S, m2_) = reshape(wdata3D, nx) * (w(ix^S, rho_) + w(ix^S, rhob_)) deallocate(wdata3D) ! Mag field pert - call read_real8_dataset(place, 'mag_field_y_pert', wdata3D) - w(ix^S, b2_) = reshape(wdata3D, nx) + call read_dataset(place, 'mag_field_y_pert', wdata3D) + w(ix^S, b2_) = reshape(wdata3D, nx)/sqrt(mu0) deallocate(wdata3D) ! Mag field bg - call read_real8_dataset(place, 'mag_field_y_bg', wdata3D) - w(ix^S, bg2_) = reshape(wdata3D, nx) + call read_dataset(place, 'mag_field_y_bg', wdata3D) + w(ix^S, bg2_) = reshape(wdata3D, nx)/sqrt(mu0) deallocate(wdata3D) end subroutine sacgdf_read_datasets_2D @@ -434,9 +438,10 @@ contains {^IFTHREED subroutine sacgdf_read_datasets_3D(place, plist_id, w, ix^L) use hdf5, only: HID_T - use gdf_datasets, only: read_real8_dataset + use gdf_datasets, only: read_dataset use common_variables, only: rho_, rhob_, m3_, b3_, bg3_ use common_variables, only: ixGhi^D, ixGlo^D, nw, nx + use phys_constants, only: mu0 implicit none @@ -448,33 +453,33 @@ contains real(kind=8), dimension(:, :, :), allocatable :: wdata3D ! Velocity - call read_real8_dataset(place, 'velocity_y', wdata3D) + call read_dataset(place, 'velocity_y', wdata3D) w(ix^S, m2_) = reshape(wdata3D, nx) * (w(ix^S, rho_) + w(ix^S, rhob_)) deallocate(wdata3D) ! Mag field pert - call read_real8_dataset(place, 'mag_field_y_pert', wdata3D) + call read_dataset(place, 'mag_field_y_pert', wdata3D) w(ix^S, b2_) = reshape(wdata3D, nx) deallocate(wdata3D) ! Mag field bg - call read_real8_dataset(place, 'mag_field_y_bg', wdata3D) + call read_dataset(place, 'mag_field_y_bg', wdata3D) w(ix^S, bg2_) = reshape(wdata3D, nx) deallocate(wdata3D) ! Velocity - call read_real8_dataset(place, 'velocity_z', wdata3D) + call read_dataset(place, 'velocity_z', wdata3D) w(ix^S, m3_) = reshape(wdata3D, nx) * (w(ix^S, rho_) + w(ix^S, rhob_)) deallocate(wdata3D) ! Mag field pert - call read_real8_dataset(place, 'mag_field_z_pert', wdata3D) - w(ix^S, b3_) = reshape(wdata3D, nx) + call read_dataset(place, 'mag_field_z_pert', wdata3D) + w(ix^S, b3_) = reshape(wdata3D, nx)/sqrt(mu0) deallocate(wdata3D) ! Mag field bg - call read_real8_dataset(place, 'mag_field_z_bg', wdata3D) - w(ix^S, bg3_) = reshape(wdata3D, nx) + call read_dataset(place, 'mag_field_z_bg', wdata3D) + w(ix^S, bg3_) = reshape(wdata3D, nx)/sqrt(mu0) deallocate(wdata3D) end subroutine sacgdf_read_datasets_3D diff --git a/sac/src/vac.t b/sac/src/vac.t index bb8d55e..6d395f5 100644 --- a/sac/src/vac.t +++ b/sac/src/vac.t @@ -58,10 +58,6 @@ PROGRAM vac CALL getboundary(t,1,nw,1,ndim,w) DO - DO ifile=1,nfile - IF(timetosave(ifile)) CALL savefile(ifile,w) - END DO - ! Determine time step IF(dtpar>zero)THEN dt=dtpar @@ -686,7 +682,6 @@ SUBROUTINE getdt_courant(w,ix^L) ELSE ! dx>0, but cmax>=0 may actually be 0, thus we calculate ! max(cmax/dx) rather than min(dx/cmax). - CALL getcmax(new_cmax,w,ix^L,idim,cmax) courantmax=MAX(courantmax,MAXVAL(cmax(ix^S)/dx(ix^S,idim))) diff --git a/sac/src/vacdef.t b/sac/src/vacdef.t index d8d21a3..62cba82 100644 --- a/sac/src/vacdef.t +++ b/sac/src/vacdef.t @@ -4,6 +4,7 @@ MODULE phys_constants INTEGER, PARAMETER :: biginteger=10000000 REAL(kind=8), PARAMETER :: pi= 3.1415926535897932384626433832795 + real(kind=8), parameter :: mu0=4.d-7*pi REAL(kind=8), PARAMETER :: smalldouble=1.d-99, bigdouble=1.d+99 REAL(kind=8), PARAMETER :: zero=0d0, one=1d0, two=2d0, half=0.5d0, quarter=0.25d0 @@ -23,7 +24,7 @@ MODULE code_constants INTEGER, PARAMETER :: ixGlo^D=1 ! The next line is edited by SETVAC - INTEGER, PARAMETER :: ixGhi1=104,ixGhi2=104,ixGhimin=104,ixGhimax=104 + INTEGER, PARAMETER :: ixGhi1=100,ixGhi2=100,ixGhimin=100,ixGhimax=100 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! INTEGER, PARAMETER :: ndim=^ND, ndir=^NC diff --git a/sac/src/vacio.t b/sac/src/vacio.t index e293eb2..f46bea0 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -790,12 +790,13 @@ subroutine readfileini_gdf(w) use gdf, only: gdf_parameters_T, gdf_root_datasets_T, gdf_field_type_T use hdf5, only: h5open_f, h5gopen_f, h5fopen_f, h5fclose_f, h5close_f, HID_T, H5F_ACC_RDONLY_F use sacgdf, only: sacgdf_read_file, build_x_array, sacgdf_read_datasets - use common_variables, only: ixGlo^D, ixGhi^D, nw, filenameini, nx, x, t, gencoord, fileheadini, rhob_ + use common_variables, only: ixGlo^D, ixGhi^D, nw, filenameini, nx, x, t, gencoord, fileheadini, rhob_, unitterm, teststr implicit none real(kind=8), intent(inout) :: w(ixG^T,nw) + logical :: oktest integer(kind=4) :: error integer(HID_T) :: file_id, grid_g_id, grid_z_id, plist_id type(gdf_parameters_T) :: gdf_sp @@ -804,10 +805,12 @@ subroutine readfileini_gdf(w) character(len=60) :: software_name, software_version !class(*), dimension(:, :, :), pointer :: r_ptr real(kind=8), dimension(:, :, :), allocatable, target :: wdata3D + integer(kind=4), dimension(^ND) :: disk_nx integer:: ndimini,neqparini,neqparin,nwini,nwin ! values describing input data integer:: ix^L + oktest=index(teststr,'readfileini')>=1 ! just in case you are reading in a gdf and saving out a binary fileheadini = 'gdf' @@ -816,7 +819,7 @@ subroutine readfileini_gdf(w) call h5open_f(error) ! Open a file for reading only - print*, trim(filenameini) + if(oktest) write(unitterm,*) "Reading GDF file: ", trim(filenameini) call h5fopen_f(trim(filenameini), H5F_ACC_RDONLY_F, file_id, error) ! init the objects @@ -840,13 +843,14 @@ subroutine readfileini_gdf(w) call checkNdimNeqparNw(ndimini,neqparini,nwini,neqparin,nwin) nx = gdf_sp%domain_dimensions(:ndimini) + disk_nx = gdf_sp%domain_dimensions(:ndimini) ! This set's up the global indicies based on nx and also ! deals with the MPI indicies etc. call setixGixMix(ix^L) ! Build the x array - call build_x_array(ix^L, nx, gdf_sp%domain_left_edge(:ndimini), gdf_sp%domain_right_edge(:ndimini), x) + call build_x_array(ix^L, disk_nx, gdf_sp%domain_left_edge(:ndimini), gdf_sp%domain_right_edge(:ndimini), x) ! Reconstruct the w array ! Create field groups @@ -1238,11 +1242,16 @@ subroutine savefileout_gdf(w,ix^L) class(*), dimension(:, :, :), pointer :: d_ptr real(kind=8), dimension(ix^S) :: wdata real(kind=8), dimension(:, :, :), allocatable, target :: wdata3D + real(kind=8), dimension(ixmax1, ixmax2, 2) :: temp_x gdf_nx = (/ 1, 1, 1 /) - gdf_nx(:^ND) = nx + gdf_nx(:^ND) = (/ ixmax^D-ixmin^D+1 /) + print*, "savefile_gdf" print*, gdf_nx + print*, ix^L + allocate(wdata3D(1:gdf_nx(1), 1:gdf_nx(2), 1:gdf_nx(3))) + print*, shape(wdata3D) ! Open file call h5open_f(error) @@ -1262,14 +1271,14 @@ subroutine savefileout_gdf(w,ix^L) gdf_sp%dimensionality = ^ND gdf_sp%domain_dimensions = gdf_nx ! on disk gdf_sp%domain_left_edge = (/ 0, 0, 0 /) - gdf_sp%domain_right_edge = (/ 0, 0, 0 /) + gdf_sp%domain_right_edge = (/ 1, 1, 1 /) gdf_sp%domain_left_edge(:^ND) = x(ixmin^D, :) !bottom left corner gdf_sp%domain_right_edge(:^ND) = x(ixmax^D, :) ! top right corner gdf_sp%field_ordering = 1 gdf_sp%num_ghost_zones = 0 !on disk gdf_sp%refine_by = 0 gdf_sp%unique_identifier = "sacgdf2014" - + ! Initilize the data call rd%init(1) @@ -1418,6 +1427,7 @@ end subroutine flushunit use gdf_datasets, only: write_dataset use common_variables, only: rho_, rhob_, e_, eb_, m1_, b1_, bg1_ use common_variables, only: ixGhi^D, ixGlo^D, nw, nx + use phys_constants, only: mu0 implicit none @@ -1433,7 +1443,7 @@ end subroutine flushunit real(kind=8), dimension(:, :, :), allocatable, target :: wdata3D gdf_nx = (/ 1, 1, 1 /) - gdf_nx(:^ND) = nx + gdf_nx(:^ND) = (/ ixmax^D-ixmin^D+1 /) allocate(wdata3D(1:gdf_nx(1), 1:gdf_nx(2), 1:gdf_nx(3))) ! Velocity @@ -1455,13 +1465,13 @@ end subroutine flushunit call write_dataset(place, 'density_bg', d_ptr, plist_id) ! Mag field pert - wdata(ix^S) = w(ix^S, b1_) + wdata(ix^S) = w(ix^S, b1_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D call write_dataset(place, 'mag_field_x_pert', d_ptr, plist_id) ! Mag field bg - wdata(ix^S) = w(ix^S, bg1_) + wdata(ix^S) = w(ix^S, bg1_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D call write_dataset(place, 'mag_field_x_bg', d_ptr, plist_id) @@ -1488,6 +1498,7 @@ end subroutine flushunit use gdf_datasets, only: write_dataset use common_variables, only: rho_, rhob_, m2_, b2_, bg2_ use common_variables, only: ixGhi^D, ixGlo^D, nw, nx + use phys_constants, only: mu0 implicit none @@ -1501,9 +1512,9 @@ end subroutine flushunit class(*), dimension(:, :, :), pointer :: d_ptr real(kind=8), dimension(ix^S), target :: wdata real(kind=8), dimension(:, :, :), allocatable, target :: wdata3D - + gdf_nx = (/ 1, 1, 1 /) - gdf_nx(:^ND) = nx + gdf_nx(:^ND) = (/ ixmax^D-ixmin^D+1 /) allocate(wdata3D(1:gdf_nx(1), 1:gdf_nx(2), 1:gdf_nx(3))) ! Velocity @@ -1513,13 +1524,13 @@ end subroutine flushunit call write_dataset(place, 'velocity_y', d_ptr, plist_id) ! Mag field pert - wdata(ix^S) = w(ix^S, b2_) + wdata(ix^S) = w(ix^S, b2_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D call write_dataset(place, 'mag_field_y_pert', d_ptr, plist_id) ! Mag field bg - wdata(ix^S) = w(ix^S, bg2_) + wdata(ix^S) = w(ix^S, bg2_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D call write_dataset(place, 'mag_field_y_bg', d_ptr, plist_id) @@ -1533,7 +1544,8 @@ end subroutine flushunit use gdf_datasets, only: write_dataset use common_variables, only: rho_, rhob_, m3_, b3_, bg3_ use common_variables, only: ixGhi^D, ixGlo^D, nw, nx - + use phys_constants, only: mu0 + implicit none integer(HID_T), intent(inout) :: place @@ -1548,7 +1560,7 @@ end subroutine flushunit real(kind=8), dimension(:, :, :), allocatable, target :: wdata3D gdf_nx = (/ 1, 1, 1 /) - gdf_nx(:^ND) = nx + gdf_nx(:^ND) = (/ ixmax^D-ixmin^D+1 /) allocate(wdata3D(1:gdf_nx(1), 1:gdf_nx(2), 1:gdf_nx(3))) ! Velocity @@ -1558,13 +1570,13 @@ end subroutine flushunit call write_dataset(place, 'velocity_y', d_ptr, plist_id) ! Mag field pert - wdata(ix^S) = w(ix^S, b2_) + wdata(ix^S) = w(ix^S, b2_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D call write_dataset(place, 'mag_field_y_pert', d_ptr, plist_id) ! Mag field bg - wdata(ix^S) = w(ix^S, bg2_) + wdata(ix^S) = w(ix^S, bg2_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D call write_dataset(place, 'mag_field_y_bg', d_ptr, plist_id) @@ -1576,13 +1588,13 @@ end subroutine flushunit call write_dataset(place, 'velocity_z', d_ptr, plist_id) ! Mag field pert - wdata(ix^S) = w(ix^S, b3_) + wdata(ix^S) = w(ix^S, b3_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D call write_dataset(place, 'mag_field_z_pert', d_ptr, plist_id) ! Mag field bg - wdata(ix^S) = w(ix^S, bg3_) + wdata(ix^S) = w(ix^S, bg3_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D call write_dataset(place, 'mag_field_z_bg', d_ptr, plist_id) diff --git a/sac/src/vacphys0.t.mhd b/sac/src/vacphys0.t.mhd index 5a48ac4..1c89835 100644 --- a/sac/src/vacphys0.t.mhd +++ b/sac/src/vacphys0.t.mhd @@ -152,7 +152,7 @@ SUBROUTINE getcsound2(w,ix^L,csound2) !----------------------------------------------------------------------------- IF(eqpar(gamma_)<=zero)& - CALL die('Correct Getcsound2 for NONIDEAL gas in vacphys.t.mhd') + CALL die('FATAL: Incorrect Getcsound2 for NONIDEAL gas in vacphys.t.mhd') oktest=INDEX(teststr,'getcsound2')>=1 IF(oktest) WRITE(*,*)'Getcsound2' From c39210fa8096af4a2f0b970b6315156e810dba57 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Mon, 22 Sep 2014 10:59:27 +0100 Subject: [PATCH 15/32] why are these even in the git repo? --- sac/binini | Bin 5633 -> 0 bytes sac/gdfini | 114 ----------------------------------------------------- 2 files changed, 114 deletions(-) delete mode 100644 sac/binini delete mode 100644 sac/gdfini diff --git a/sac/binini b/sac/binini deleted file mode 100644 index 8b8cfb3927f512375a9a69a850f2cb76e92c8905..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 5633 zcmeGgO>g5=ut@BomNk|0l5}l1?KYJxt!q15BYy_VCd0OhVC%TOK-B1MGqC-l=-B(YM$KSV3TK^MwXr5pBw=}AfgNvw3b zrSSvy-RmjCPN~;POX+F%q({G{XgE44jgn|GN#YVx`eEEjk}=AJlW3BbhNDOTFATc1 z=p-~_1bX-}KtvQrimV@_O;-)AvIPOM6gk^}shofMOpF0pgQa}=g z_zV!N?$DnA$ImeYK$+PfNj^wJv_OL`PQiKMySh8aS9j4>AZ_mCqnZ!SL3>ypFNY#s zZbyJK_!tH-lwc@B2yF@4IJaRuNZQcuBiN_Y=m*1L0AU)?_c%C}*zYChw02`H8{dBU z=g*HmU0ZuChxx=|QT>b2-dxt`(0uYUdR8Op=&!^b28Is9R#^ds?g-n>iG z+A|z9|FAcGO!kicc*5oE$zD&)HLft>?Gze`4&qsI$4~ z=j>sZk>J){Hh=U@rniV+dHuxB5XG@)33I!`%sjXP1 zAa+sP*5zfs*p2|nG=*_?{|e9!Iu9U<83J$8U^o%rFc`;C+$S_$+;u{SX*izjfs?=_ zI1Q<>=tgOj#L!E|>_$h6vmpuK+v*YC!&!-1Iz@@G31D&-f+b=>srz+f|6P!7F&@C1 zyceBe^Frh0ea-C3ugLD!E3#YpukC_y!RX zSjXmMJzQ@~>usFd>(rdAV{?Lkm$V>xuv}07z6S)TnU-;2sJh$qujtnQvGt z9uUCzpssqDO$G0b5>z${ZEtO^j*ddm(im2)>)zJ(kiNi@6j*yh$YfZ~iU}vM# zt?)CiY{b)(9LSjJo}tr&Y$Jb6&ZJGdj?zdtFM*Nf8@QQENS0}voHmT&VZyG2%#h*u zo?E|vK`zH@u2EB%8?aYqL$2Fo%t z)inm_rroGprq2LsLuQC+JQau_b@va%ROxPM!m5R&?1`S zamLimHd)Cj47*|}Bt2Wq#lzdh!;`jhU54kmbQ@fVgjrc9ZJuFaZ(bJ9zpmyRV>S<2 zsk$s+?ilZh)!p1C2BnXMZoX%k?>VQ)a}sRlLRm4-eSy9I0@|Ssx zo=&p&Kvwt|fo_J=pmW@gI(=R{iD0YC0)%snLmvwz&wt7~!)wi9yfqBExi|yzlNt`P zTa5!-meDe-8SQ;ltEr7SZ&nysg5MS(jJxwk7JE$zjWigipmtA#xWlVF9i0S|up`v) W|D%(^GMT9I0u^0>S;pNpr~VCr$CX6@ diff --git a/sac/gdfini b/sac/gdfini deleted file mode 100644 index f1bbbd8..0000000 --- a/sac/gdfini +++ /dev/null @@ -1,114 +0,0 @@ -VAC 4.52 configured to - -d=22 -phi=0 -z=0 -g=104,104 -p=mhd -u=default - -on=cd,rk - -off=mc,fct,tvdlf,tvd,impl,poisson,ct,gencoord,resist,mpi - ReadParameters -&TESTLIST - TESTSTR=readfileini readparameters - IXTEST1= 3, - IXTEST2= 3, - IXTEST3= 3, - IWTEST= 1, - IDIMTEST= 1, - / - /archive/mhdmodes_2D_ini.gdf - /archive/mhdmodes_2D.log - /archive/mhdmodes_2D - Type of ini/out and log files:gdf gdf default - Fullgridini,out: F F - /archive/mhdmodes_2D_ini.gdf - Do some value tests - 3 3 98 98 - 104 104 10 - density_bg 9216.0000000000000 - out readini - back in readparams - DTSAVE for file 1 =1.0000 - DTSAVE for file 2 =.10000 - TMAX= 0.20000000000000001 - ITMAX= 10000 - TYPEB( 1) = fixed fixed fixed fixed fixed fixed fixed fixed fixed fixed - TYPEB( 2) = fixed fixed fixed fixed fixed fixed fixed fixed fixed fixed - TYPEB( 3) = fixed fixed fixed fixed fixed fixed fixed fixed fixed fixed - TYPEB( 4) = fixed fixed fixed fixed fixed fixed fixed fixed fixed fixed - EXTRAB = F -&METHODLIST - WNAMES=h m1 m2 e b1 b2 eb rhob bg1 bg2 - FILEHEADOUT=gdf - EQPAR= 6*0.0000000000000000 , - TYPEADVANCE=onestep - TYPEFULL= 6*cd4 4*nul - TYPEPRED= 10*default - TYPEIMPL= 10*nul - TYPEFILTER= 10*nul - TYPELIMITER= 10*minmod - TYPEENTROPY= 10*nul - ENTROPYCOEF= 4*0.20000000298023224 , 2*-1.0000000000000000 , 2*0.40000000596046448 , 2*-1.0000000000000000 , - ARTCOMP= 10*F, - TYPELIMITED=previous - TYPEFCT=etbfct - TYPETVD=roe - TYPEAXIAL=slab - TYPEPOISSON=default - TYPECONSTRAIN=nul - CONSTRAINCOEF= 1.0000000000000000 , - USEPRIMITIVE=F, - MUSCLETA= 0.0000000000000000 , - MUSCLOMEGA= 0.0000000000000000 , - ACMWIDTH= 1, - ACMNOLIM=F, - ACMCOEF= 10*-1.0000000000000000 , - ACMEXPO= 0.0000000000000000 , - FOURTHORDER=F, - IMPLMRPC=F, - DIMSPLIT=F, - TYPEDIMSPLIT=unsplit - SOURCESPLIT=F, - TYPESOURCESPLIT=unsplit - SOURCEUNSPLIT=T, - DIVBFIX=F, - DIVBWAVE=T, - DIVBCONSTRAIN=F, - ANGMOMFIX=F, - COMPACTRES=F, - SMALLFIX=F, - SMALLP= 10.000000000000000 , - SMALLPCOEFF= 9.9999999999999995E-007, - SMALLRHO= -1.0000000000000000 , - SMALLRHOCOEFF= 9.9999999999999995E-007, - VACUUMRHO= -1.0000000000000000 , - NPROC= 4*0 , - PROCPAR= 3*-1.0000000000000000 , - / -&PARAMLIST - COURANTPAR= 0.20000000000000001 , - DTPAR= -1.0000000000000000 , - DTDIFFPAR= 0.50000000000000000 , - DTCANTGROW=F, - SLOWSTEPS= 0, - IMPLMRPCPAR= 4, - IMPLPAR= -1.0000000000000000 , - IMPLDIFFPAR= 9.9999999999999998E-013, - IMPLERROR= 0.0000000000000000 , - IMPLRELAX=-0.50000000000000000 , - IMPLDWLIMIT= 9.9999999999999997E+098, - IMPLRESTART= 20, - IMPLRESTART2= 5, - IMPLITER= 100, - IMPLITERNR= 20, - TYPEIMPLINIT=unused - TYPEIMPLITER=vac_bicg - TYPEIMPLMAT=unused - IMPLNEWTON=F, - IMPLCONSERV=F, - IMPLCENTERED=F, - IMPLNEWMAT=F, - IMPLPRED=F, - IMPL3LEVEL=F, - IMPLJACFAST=F, - IMPLSOURCE=T, - / - Warning: incomplete input headline. Added to output headline _mhd22 - end readparameters -Start Advance 0.006 sec - Correct Getcsound2 for NONIDEAL gas in vacphys.t.mhd From fcb8a69fec879cf6b4b6cc0874f5d328dff7dfd5 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Mon, 22 Sep 2014 18:15:15 +0100 Subject: [PATCH 16/32] Working read and write for non-fullgrid. Need some robust code, but it seems to be working. --- sac/par/binout | 1 + sac/par/gdfini | 6 +++--- sac/par/gdfout | 2 +- sac/src/sacgdf.t | 8 ++++---- sac/src/vac.t | 5 +++++ sac/src/vacio.t | 10 +++------- 6 files changed, 17 insertions(+), 15 deletions(-) diff --git a/sac/par/binout b/sac/par/binout index 43a5515..c9c96b4 100644 --- a/sac/par/binout +++ b/sac/par/binout @@ -14,6 +14,7 @@ / &savelist + dtsave = 1,0.1 itsave(1,2)=0 / diff --git a/sac/par/gdfini b/sac/par/gdfini index ed11c64..f106f03 100644 --- a/sac/par/gdfini +++ b/sac/par/gdfini @@ -7,10 +7,10 @@ typefileini='gdf' filename= '/archive/gdf_testing/mhdmodes_2D.log', - '/archive/gdf_testing/mhdmodes_2D_gdfini_' + '/archive/gdf_testing/mhdmodes_2D_ii_' typefileout='gdf' - fullgridout= T - fullgridini= T + fullgridout= F + fullgridini= F / &savelist diff --git a/sac/par/gdfout b/sac/par/gdfout index 5060bbe..855098a 100644 --- a/sac/par/gdfout +++ b/sac/par/gdfout @@ -9,7 +9,7 @@ filename= '/archive/gdf_testing/mhdmodes_2D.log', '/archive/gdf_testing/mhdmodes_2D_' typefileout='gdf' - fullgridout= T + fullgridout= F fullgridini= T / diff --git a/sac/src/sacgdf.t b/sac/src/sacgdf.t index 9ca7a52..3c92e9a 100644 --- a/sac/src/sacgdf.t +++ b/sac/src/sacgdf.t @@ -292,9 +292,9 @@ contains call read_attribute(g_id, 'nu', r_ptr) eqpar(nu_:nu_) = r_ptr - i4_ptr => it_arr + allocate(i4_ptr(1)) call read_attribute(g_id, 'current_iteration', i4_ptr) - it = it_arr(1) + it = i4_ptr(1) call h5gclose_f(g_id, error) @@ -459,12 +459,12 @@ contains ! Mag field pert call read_dataset(place, 'mag_field_y_pert', wdata3D) - w(ix^S, b2_) = reshape(wdata3D, nx) + w(ix^S, b2_) = reshape(wdata3D, nx)/sqrt(mu0) deallocate(wdata3D) ! Mag field bg call read_dataset(place, 'mag_field_y_bg', wdata3D) - w(ix^S, bg2_) = reshape(wdata3D, nx) + w(ix^S, bg2_) = reshape(wdata3D, nx)/sqrt(mu0) deallocate(wdata3D) ! Velocity diff --git a/sac/src/vac.t b/sac/src/vac.t index 6d395f5..bb8d55e 100644 --- a/sac/src/vac.t +++ b/sac/src/vac.t @@ -58,6 +58,10 @@ PROGRAM vac CALL getboundary(t,1,nw,1,ndim,w) DO + DO ifile=1,nfile + IF(timetosave(ifile)) CALL savefile(ifile,w) + END DO + ! Determine time step IF(dtpar>zero)THEN dt=dtpar @@ -682,6 +686,7 @@ SUBROUTINE getdt_courant(w,ix^L) ELSE ! dx>0, but cmax>=0 may actually be 0, thus we calculate ! max(cmax/dx) rather than min(dx/cmax). + CALL getcmax(new_cmax,w,ix^L,idim,cmax) courantmax=MAX(courantmax,MAXVAL(cmax(ix^S)/dx(ix^S,idim))) diff --git a/sac/src/vacio.t b/sac/src/vacio.t index f46bea0..7a139f7 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -790,7 +790,7 @@ subroutine readfileini_gdf(w) use gdf, only: gdf_parameters_T, gdf_root_datasets_T, gdf_field_type_T use hdf5, only: h5open_f, h5gopen_f, h5fopen_f, h5fclose_f, h5close_f, HID_T, H5F_ACC_RDONLY_F use sacgdf, only: sacgdf_read_file, build_x_array, sacgdf_read_datasets - use common_variables, only: ixGlo^D, ixGhi^D, nw, filenameini, nx, x, t, gencoord, fileheadini, rhob_, unitterm, teststr + use common_variables, only: ixGlo^D, ixGhi^D, nw, filenameini, nx, x, t, gencoord, fileheadini, unitterm, teststr implicit none @@ -844,6 +844,7 @@ subroutine readfileini_gdf(w) nx = gdf_sp%domain_dimensions(:ndimini) disk_nx = gdf_sp%domain_dimensions(:ndimini) + t = gdf_sp%current_time(1) ! This set's up the global indicies based on nx and also ! deals with the MPI indicies etc. @@ -859,11 +860,6 @@ subroutine readfileini_gdf(w) call sacgdf_read_datasets(grid_z_id, plist_id, w, ix^L) - print*, "Do some value tests" - print*, ix^L - print*, shape(w) - print*, "density_bg", sum(w(ix^S, rhob_)) - ! Close the file and interface call h5fclose_f(file_id, error) call h5close_f(error) @@ -1028,7 +1024,7 @@ subroutine savefile(ifile,w) real(kind=8):: w(ixG^T,nw) character(10):: itstring !----------------------------------------------------------------------------- - + print*, "in savefile" !if(nproc(ifile+2)>0) call process(ifile+2,1,ndim,w) ! In most cases the mesh should be saved From 59571b5c2330a718bafcae780275c6de365e33c6 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Tue, 23 Sep 2014 17:56:47 +0100 Subject: [PATCH 17/32] Towards parallel write --- sac/src/fgdfio | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sac/src/fgdfio b/sac/src/fgdfio index 224ee15..04e3410 160000 --- a/sac/src/fgdfio +++ b/sac/src/fgdfio @@ -1 +1 @@ -Subproject commit 224ee1554cc0861e7525a467b422b8bf0be0c4ce +Subproject commit 04e34101a3086967d60062681d31eb3c48d5712a From 4b3a5687774c81660c8656626b988e7ecf50923a Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Wed, 24 Sep 2014 17:09:54 +0100 Subject: [PATCH 18/32] More fgdfio updates, closer to parallel write. --- sac/src/fgdfio | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sac/src/fgdfio b/sac/src/fgdfio index 04e3410..b11b5b3 160000 --- a/sac/src/fgdfio +++ b/sac/src/fgdfio @@ -1 +1 @@ -Subproject commit 04e34101a3086967d60062681d31eb3c48d5712a +Subproject commit b11b5b3b825bd3f8567a01882251cf1cae533c07 From c239ea34416606809fa1082be413d1cbe80e2568 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Mon, 29 Sep 2014 16:17:18 +0100 Subject: [PATCH 19/32] update fgdfio --- sac/src/fgdfio | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sac/src/fgdfio b/sac/src/fgdfio index b11b5b3..cdddd1d 160000 --- a/sac/src/fgdfio +++ b/sac/src/fgdfio @@ -1 +1 @@ -Subproject commit b11b5b3b825bd3f8567a01882251cf1cae533c07 +Subproject commit cdddd1d88433a43ebc57fe6a39480c11ca084f01 From c640aaa5189838f014db409db08b2f77a00bae9b Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Wed, 1 Oct 2014 10:37:22 +0100 Subject: [PATCH 20/32] Compile on iceberg --- sac/par/gdfini | 6 +++--- sac/par/gdfout | 6 +++--- sac/src/vac.t | 2 +- sac/src/vacio.t | 6 ++++-- 4 files changed, 11 insertions(+), 9 deletions(-) diff --git a/sac/par/gdfini b/sac/par/gdfini index f106f03..6502323 100644 --- a/sac/par/gdfini +++ b/sac/par/gdfini @@ -3,11 +3,11 @@ / &filelist - filenameini='/archive/gdf_testing/mhdmodes_2D_00000000.gdf' + filenameini='/home/cs1sjm/gdf_testing/mhdmodes_2D_00000000.gdf' typefileini='gdf' - filename= '/archive/gdf_testing/mhdmodes_2D.log', - '/archive/gdf_testing/mhdmodes_2D_ii_' + filename= '/home/cs1sjm/gdf_testing/mhdmodes_2D.log', + '/home/cs1sjm/gdf_testing/mhdmodes_2D_ii_' typefileout='gdf' fullgridout= F fullgridini= F diff --git a/sac/par/gdfout b/sac/par/gdfout index 855098a..c386dde 100644 --- a/sac/par/gdfout +++ b/sac/par/gdfout @@ -3,11 +3,11 @@ / &filelist - filenameini='/archive/gdf_testing/mhdmodes_2D.ini' + filenameini='/home/cs1sjm/gdf_testing/mhdmodes_2D.ini' typefileini='binary' - filename= '/archive/gdf_testing/mhdmodes_2D.log', - '/archive/gdf_testing/mhdmodes_2D_' + filename= '/home/cs1sjm/gdf_testing/mhdmodes_2D.log', + '/home/cs1sjm/gdf_testing/mhdmodes_2D_' typefileout='gdf' fullgridout= F fullgridini= T diff --git a/sac/src/vac.t b/sac/src/vac.t index bb8d55e..bed991d 100644 --- a/sac/src/vac.t +++ b/sac/src/vac.t @@ -25,7 +25,7 @@ PROGRAM vac verbose=.TRUE. .AND.ipe==0^IFMPI IF(verbose)THEN WRITE(*,'(a)')'VAC 4.52 configured to' - WRITE(*,'(a)')' -d=22 -phi=0 -z=0 -g=104,104 -p=mhd -u=default' + WRITE(*,'(a)')' -d=22 -phi=0 -z=0 -g=100,100 -p=mhd -u=default' WRITE(*,'(a)')' -on=cd,rk' WRITE(*,'(a)')' -off=mc,fct,tvdlf,tvd,impl,poisson,ct,gencoord,resist,mpi' {^IFMPI WRITE(*,'(a,i3,a)')'Running on ',npe,' processors'} diff --git a/sac/src/vacio.t b/sac/src/vacio.t index 7a139f7..3903d5c 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -1223,7 +1223,7 @@ subroutine savefileout_gdf(w,ix^L) real(kind=8), intent(IN):: w(ixG^T,nw) integer(HID_T) :: file_id - integer(HID_T) :: plist_id !< Property list identifier + integer(HID_T) :: plist_id, xfer_prp !< Property list identifier integer(HID_T) :: doml_g_id !< domain list identifier integer(HID_T) :: dom_g_id !< domain group identifier integer :: error @@ -1294,7 +1294,9 @@ subroutine savefileout_gdf(w,ix^L) call h5gcreate_f(dom_g_id, "grid_0000000000", doml_g_id, error) !Create the top grid ! WRITE ACTUAL DATA HERE - call sacgdf_write_datasets(doml_g_id, plist_id, w, ix^L) + + call h5pcreate_f(H5P_DATASET_XFER_F, xfer_prp, error) + call sacgdf_write_datasets(doml_g_id, xfer_prp, w, ix^L) call h5fclose_f(file_id, error) call h5close_f(error) From 26b6f07a756a2b28b09657a32d099b0dc1c0e7e1 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Fri, 3 Oct 2014 17:42:26 +0100 Subject: [PATCH 21/32] Moving towards parallel out. Currently not working is dealing with making gdf files not add the processor rank to the filename. --- sac/src/Makefile | 4 +- sac/src/vac.t | 4 +- sac/src/vacio.t | 87 ++++++---- sac/src/vacmpi.t | 426 ++++++++++++++++++++++++----------------------- sac/src/vacpp.pl | 2 +- 5 files changed, 278 insertions(+), 245 deletions(-) diff --git a/sac/src/Makefile b/sac/src/Makefile index f74deec..2ed0b48 100644 --- a/sac/src/Makefile +++ b/sac/src/Makefile @@ -37,8 +37,8 @@ VAC_OBJ = vac$O vacio$O vacgrid$O vacphys0$O vacphys$O vacusr$O # The VACCD, VACMC, VACFCT, VACTVDLF, VACTVD, VACIMPL, VACPOISSON, VACMPI # modules are removed or added in the following two lines by "setvac". # DO NOT TOUCH THESE TWO LINES: -VACFOR = $(VAC_FOR) vaccd$F -VACOBJ = $(VAC_OBJ) vaccd$O +VACFOR = $(VAC_FOR) vaccd$F vacmpi$F +VACOBJ = $(VAC_OBJ) vaccd$O vacmpi$O ROEOBJ = roetest$O vacphys0$O vacphys$O diff --git a/sac/src/vac.t b/sac/src/vac.t index bed991d..fa6c645 100644 --- a/sac/src/vac.t +++ b/sac/src/vac.t @@ -26,8 +26,8 @@ PROGRAM vac IF(verbose)THEN WRITE(*,'(a)')'VAC 4.52 configured to' WRITE(*,'(a)')' -d=22 -phi=0 -z=0 -g=100,100 -p=mhd -u=default' - WRITE(*,'(a)')' -on=cd,rk' - WRITE(*,'(a)')' -off=mc,fct,tvdlf,tvd,impl,poisson,ct,gencoord,resist,mpi' + WRITE(*,'(a)')' -on=cd,rk,mpi' + WRITE(*,'(a)')' -off=mc,fct,tvdlf,tvd,impl,poisson,ct,gencoord,resist' {^IFMPI WRITE(*,'(a,i3,a)')'Running on ',npe,' processors'} ENDIF diff --git a/sac/src/vacio.t b/sac/src/vacio.t index 3903d5c..890babd 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -192,8 +192,8 @@ subroutine readparameters(w) {^IFMPI ! Extract and check the directional processor numbers and indexes ! and concat the PE number to the input and output filenames - call mpisetnpeDipeD(filenameini) - call mpisetnpeDipeD(filename(fileout_)) + call mpisetnpeDipeD(filenameini, 'inifile') + call mpisetnpeDipeD(filename(fileout_), 'outfile') } if(oktest) then @@ -1239,6 +1239,7 @@ subroutine savefileout_gdf(w,ix^L) real(kind=8), dimension(ix^S) :: wdata real(kind=8), dimension(:, :, :), allocatable, target :: wdata3D real(kind=8), dimension(ixmax1, ixmax2, 2) :: temp_x + integer(kind=8), dimension(3) :: offset, count, file_dims gdf_nx = (/ 1, 1, 1 /) gdf_nx(:^ND) = (/ ixmax^D-ixmin^D+1 /) @@ -1295,9 +1296,28 @@ subroutine savefileout_gdf(w,ix^L) ! WRITE ACTUAL DATA HERE - call h5pcreate_f(H5P_DATASET_XFER_F, xfer_prp, error) - call sacgdf_write_datasets(doml_g_id, xfer_prp, w, ix^L) + !Calculate offset and count + offset = (/ 0, 0, 0 /) + count = (/ 1, 1, 1 /) + {count(^D) = ixmax^D; } + file_dims = (/ 1, 1, 1 /) + {file_dims(^D) = ixmax^D * npe^D; } + print*, file_dims + ! If we are not in MPI mode use the default xfer_prp + xfer_prp = H5P_DEFAULT_F + + {^IFMPI + {offset(^D) = ixmax^D * ipe^D; } + {count(^D) = ixmax^D; } + ! Create property list for collective dataset write + call h5pcreate_f(H5P_DATASET_XFER_F, xfer_prp, error) + call h5pset_dxpl_mpio_f(xfer_prp, H5FD_MPIO_COLLECTIVE_F, error) + } + + call h5pcreate_f(H5P_DATASET_XFER_F, xfer_prp, error) + call sacgdf_write_datasets(doml_g_id, w, ix^L, xfer_prp, file_dims, offset, count) + call h5fclose_f(file_id, error) call h5close_f(error) @@ -1401,7 +1421,7 @@ end subroutine flushunit !================================================================================ - subroutine sacgdf_write_datasets(place, plist_id, w, ix^L) + subroutine sacgdf_write_datasets(place, w, ix^L, xfer_prp, file_dims, offset, count) use hdf5, only: HID_T use gdf_datasets use common_variables, only: ixGhi^D, ixGlo^D, nw @@ -1409,18 +1429,19 @@ end subroutine flushunit implicit none integer(HID_T), intent(inout) :: place - integer(HID_T), intent(inout) :: plist_id !< Property list identifier + integer(HID_T), intent(inout) :: xfer_prp + integer(kind=8), dimension(3), intent(inout) :: offset, count, file_dims integer, intent(in) :: ix^L real(kind=8), intent(in):: w(ixG^T,nw) - call sacgdf_write_datasets_1D(place, plist_id, w, ix^L) - {^IFTWOD call sacgdf_write_datasets_2D(place, plist_id, w, ix^L) } - {^IFTHREED call sacgdf_write_datasets_3D(place, plist_id, w, ix^L) } + call sacgdf_write_datasets_1D(place, w, ix^L, xfer_prp, file_dims, offset, count) + {^IFTWOD call sacgdf_write_datasets_2D(place, w, ix^L, xfer_prp, file_dims, offset, count) } + {^IFTHREED call sacgdf_write_datasets_3D(place, w, ix^L, xfer_prp, file_dims, offset, count) } end subroutine sacgdf_write_datasets - subroutine sacgdf_write_datasets_1D(place, plist_id, w, ix^L) + subroutine sacgdf_write_datasets_1D(place, w, ix^L, xfer_prp, file_dims, offset, count) use hdf5, only: HID_T use gdf_datasets, only: write_dataset use common_variables, only: rho_, rhob_, e_, eb_, m1_, b1_, bg1_ @@ -1430,7 +1451,8 @@ end subroutine flushunit implicit none integer(HID_T), intent(inout) :: place - integer(HID_T), intent(inout) :: plist_id !< Property list identifier + integer(HID_T), intent(inout) :: xfer_prp + integer(kind=8), dimension(3), intent(inout) :: offset, count, file_dims integer, intent(in) :: ix^L real(kind=8), intent(in) :: w(ixG^T,nw) @@ -1448,50 +1470,49 @@ end subroutine flushunit wdata(ix^S) = w(ix^S, m1_) / (w(ix^S, rho_) + w(ix^S, rhob_)) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'velocity_x', d_ptr, plist_id) - + call write_dataset(place, 'velocity_x', d_ptr, xfer_prp, file_dims, count, offset) ! Density pert wdata(ix^S) = w(ix^S, rho_) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'density_pert', d_ptr, plist_id) + call write_dataset(place, 'density_pert', d_ptr, xfer_prp, file_dims, count, offset) ! Denisty bg wdata(ix^S) = w(ix^S, rhob_) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'density_bg', d_ptr, plist_id) + call write_dataset(place, 'density_bg', d_ptr, xfer_prp, file_dims, count, offset) ! Mag field pert wdata(ix^S) = w(ix^S, b1_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'mag_field_x_pert', d_ptr, plist_id) + call write_dataset(place, 'mag_field_x_pert', d_ptr, xfer_prp, file_dims, count, offset) ! Mag field bg wdata(ix^S) = w(ix^S, bg1_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'mag_field_x_bg', d_ptr, plist_id) + call write_dataset(place, 'mag_field_x_bg', d_ptr, xfer_prp, file_dims, count, offset) ! internal energy pert wdata(ix^S) = w(ix^S, e_) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'internal_energy_pert', d_ptr, plist_id) + call write_dataset(place, 'internal_energy_pert', d_ptr, xfer_prp, file_dims, count, offset) ! internal energy bg wdata(ix^S) = w(ix^S, eb_) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'internal_energy_bg', d_ptr, plist_id) + call write_dataset(place, 'internal_energy_bg', d_ptr, xfer_prp, file_dims, count, offset) end subroutine sacgdf_write_datasets_1D {^IFTWOD - subroutine sacgdf_write_datasets_2D(place, plist_id, w, ix^L) + subroutine sacgdf_write_datasets_2D(place, w, ix^L, xfer_prp, file_dims, offset, count) use hdf5, only: HID_T use gdf_datasets, only: write_dataset use common_variables, only: rho_, rhob_, m2_, b2_, bg2_ @@ -1501,7 +1522,8 @@ end subroutine flushunit implicit none integer(HID_T), intent(inout) :: place - integer(HID_T), intent(inout) :: plist_id !< Property list identifier + integer(HID_T), intent(inout) :: xfer_prp + integer(kind=8), dimension(3), intent(inout) :: offset, count, file_dims integer, intent(in) :: ix^L real(kind=8), intent(in) :: w(ixG^T,nw) @@ -1519,25 +1541,25 @@ end subroutine flushunit wdata(ix^S) = w(ix^S, m2_) / (w(ix^S, rho_) + w(ix^S, rhob_)) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'velocity_y', d_ptr, plist_id) + call write_dataset(place, 'velocity_y', d_ptr, xfer_prp, file_dims, count, offset) ! Mag field pert wdata(ix^S) = w(ix^S, b2_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'mag_field_y_pert', d_ptr, plist_id) + call write_dataset(place, 'mag_field_y_pert', d_ptr, xfer_prp, file_dims, count, offset) ! Mag field bg wdata(ix^S) = w(ix^S, bg2_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'mag_field_y_bg', d_ptr, plist_id) + call write_dataset(place, 'mag_field_y_bg', d_ptr, xfer_prp, file_dims, count, offset) end subroutine sacgdf_write_datasets_2D } {^IFTHREED - subroutine sacgdf_write_datasets_3D(place, plist_id, w, ix^L) + subroutine sacgdf_write_datasets_3D(place, w, ix^L, xfer_prp, file_dims, offset, count) use hdf5, only: HID_T use gdf_datasets, only: write_dataset use common_variables, only: rho_, rhob_, m3_, b3_, bg3_ @@ -1547,7 +1569,8 @@ end subroutine flushunit implicit none integer(HID_T), intent(inout) :: place - integer(HID_T), intent(inout) :: plist_id !< Property list identifier + integer(HID_T), intent(inout) :: xfer_prp + integer(kind=8), dimension(3), intent(inout) :: offset, count, filedims integer, intent(in) :: ix^L real(kind=8), intent(in) :: w(ixG^T,nw) @@ -1565,37 +1588,37 @@ end subroutine flushunit wdata(ix^S) = w(ix^S, m2_) / (w(ix^S, rho_) + w(ix^S, rhob_)) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'velocity_y', d_ptr, plist_id) + call write_dataset(place, 'velocity_y', d_ptr, xfer_prp, file_dims, count, offset) ! Mag field pert wdata(ix^S) = w(ix^S, b2_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'mag_field_y_pert', d_ptr, plist_id) + call write_dataset(place, 'mag_field_y_pert', d_ptr, xfer_prp, file_dims, count, offset) ! Mag field bg wdata(ix^S) = w(ix^S, bg2_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'mag_field_y_bg', d_ptr, plist_id) + call write_dataset(place, 'mag_field_y_bg', d_ptr, xfer_prp, file_dims, count, offset) ! Velocity wdata(ix^S) = w(ix^S, m3_) / (w(ix^S, rho_) + w(ix^S, rhob_)) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'velocity_z', d_ptr, plist_id) + call write_dataset(place, 'velocity_z', d_ptr, xfer_prp, file_dims, count, offset) ! Mag field pert wdata(ix^S) = w(ix^S, b3_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'mag_field_z_pert', d_ptr, plist_id) + call write_dataset(place, 'mag_field_z_pert', d_ptr, xfer_prp, file_dims, count, offset) ! Mag field bg wdata(ix^S) = w(ix^S, bg3_)*sqrt(mu0) wdata3D = reshape(wdata, gdf_nx) d_ptr => wdata3D - call write_dataset(place, 'mag_field_z_bg', d_ptr, plist_id) + call write_dataset(place, 'mag_field_z_bg', d_ptr, xfer_prp, file_dims, count, offset) end subroutine sacgdf_write_datasets_3D diff --git a/sac/src/vacmpi.t b/sac/src/vacmpi.t index 9a779db..a2f2fea 100644 --- a/sac/src/vacmpi.t +++ b/sac/src/vacmpi.t @@ -1,177 +1,187 @@ !============================================================================= -SUBROUTINE mpiinit +subroutine mpiinit ! Initialize MPI variables - USE constants - USE common_variables + use constants + use common_variables !---------------------------------------------------------------------------- - CALL MPI_INIT(ierrmpi) - CALL MPI_COMM_RANK (MPI_COMM_WORLD, ipe, ierrmpi) - CALL MPI_COMM_SIZE (MPI_COMM_WORLD, npe, ierrmpi) + call MPI_INIT(ierrmpi) + call MPI_COMM_RANK (MPI_COMM_WORLD, ipe, ierrmpi) + call MPI_COMM_SIZE (MPI_COMM_WORLD, npe, ierrmpi) ! unset values for directional processor numbers npe^D=-1; ! default value for test processor ipetest=0 - RETURN -END SUBROUTINE mpiinit + return +end subroutine mpiinit !============================================================================== -SUBROUTINE mpifinalize +subroutine mpifinalize - USE constants - USE common_variables + use constants + use common_variables - CALL MPI_BARRIER(MPI_COMM_WORLD,ierrmpi) - CALL MPI_FINALIZE(ierrmpi) + call MPI_BARRIER(MPI_COMM_WORLD,ierrmpi) + call MPI_FINALIZE(ierrmpi) - RETURN -END SUBROUTINE mpifinalize + return +end subroutine mpifinalize !============================================================================== -SUBROUTINE ipe2ipeD(qipe,qipe^D) +subroutine ipe2ipeD(qipe,qipe^D) ! Convert serial processor index to directional processor indexes - USE constants - USE common_variables + use constants + use common_variables - INTEGER:: qipe^D, qipe + integer:: qipe^D, qipe !----------------------------------------------------------------------------- qipe1 = qipe - npe1*(qipe/npe1) {qipe2 = qipe/npe1 - npe2*(qipe/(npe1*npe2)) ^NOONED} {qipe3 = qipe/(npe1*npe2) ^IFTHREED} - RETURN -END SUBROUTINE ipe2ipeD + return +end subroutine ipe2ipeD !============================================================================== -SUBROUTINE ipeD2ipe(qipe^D,qipe) +subroutine ipeD2ipe(qipe^D,qipe) ! Convert directional processor indexes to serial processor index - USE constants - USE common_variables + use constants + use common_variables - INTEGER:: qipe^D, qipe + integer:: qipe^D, qipe !----------------------------------------------------------------------------- qipe = qipe1 {^NOONED + npe1*qipe2} {^IFTHREED + npe1*npe2*qipe3} - RETURN -END SUBROUTINE ipeD2ipe + return +end subroutine ipeD2ipe !============================================================================== -SUBROUTINE mpisetnpeDipeD(name) +subroutine mpisetnpeDipeD(name, filetype) ! Set directional processor numbers and indexes based on a filename. ! The filename contains _np followed by np^D written with 2 digit integers. ! For example _np0203 means np1=2, np2=3 for 2D. - - USE constants - USE common_variables - CHARACTER(^LENNAME) :: name, nametail - INTEGER:: i,qnpe^D - LOGICAL:: npeDknown,npeDinname + use constants + use common_variables + + implicit none + + character(^LENNAME), intent(inout) :: name, filetype + character(^LENNAME) :: nametail + integer:: i,qnpe^D + logical:: npeDknown,npeDinname !----------------------------------------------------------------------------- - oktest = INDEX(teststr,'mpisetnpeDipeD')>0 - IF(oktest)WRITE(*,*)'mpisetnpeDipeD ipe,name=',ipe,name + oktest = index(teststr,'mpisetnpeDipeD')>0 + if(oktest)write(*,*)'mpisetnpeDipeD ipe,name=',ipe,name ! Check if npe^D is already known npeDknown = npe1>0 - IF(npedknown .AND. npe^D* /= npe)THEN - WRITE(*,*)'npe=',npe,' /= product of npe^D=',npe^D - CALL mpistop('ERROR in setnpeDipeD') - ENDIF + if(npedknown .and. npe^D* /= npe)then + write(*,*)'npe=',npe,' /= product of npe^D=',npe^D + call mpistop('ERROR in setnpeDipeD') + endif ! Check if npe^D is given in the name - i=INDEX(name,'_np')+3 + i=index(name,'_np')+3 npeDinname = i>3 - IF(.NOT.(npeDknown.OR.npeDinname))CALL mpistop( & + if(.not.(npeDknown.or.npeDinname))call mpistop( & 'ERROR in setnpeDipeD: npeD is neither known nor given in name='//name) - IF(npeDinname)THEN + if(npeDinname)then ! read npe^D from name - READ(name(i:i+5),'(3i2)') qnpe^D + read(name(i:i+5),'(3i2)') qnpe^D i=i+2*^ND nametail=name(i:^LENNAME) - ENDIF + endif - IF( npeDknown .AND. npeDinname )THEN + if( npeDknown .and. npeDinname )then ! Check agreement - IF( qnpe^D/=npe^D|.OR. )THEN - WRITE(*,*)'npe^D=',npe^D,' /= qnpe^D=',qnpe^D,' read from filename=',name - CALL mpistop('ERROR in mpisetnpeDipeD') - ENDIF - ENDIF + if( qnpe^D/=npe^D|.or. )then + write(*,*)'npe^D=',npe^D,' /= qnpe^D=',qnpe^D,' read from filename=',name + call mpistop('ERROR in mpisetnpeDipeD') + endif + endif - IF(npeDinname .AND. .NOT.npeDknown)THEN + if(npeDinname .and. .not.npeDknown)then ! set npe^D based on name npe^D=qnpe^D; - IF( npe^D* /= npe)THEN - WRITE(*,*)'npe=',npe,' /= product of npe^D=',npe^D,& + if( npe^D* /= npe)then + write(*,*)'npe=',npe,' /= product of npe^D=',npe^D,& ' read from filename=',name - CALL mpistop('ERROR in setnpeDipeD') - ENDIF - ENDIF + call mpistop('ERROR in setnpeDipeD') + endif + endif ! Get directional processor indexes - CALL ipe2ipeD(ipe,ipe^D) + call ipe2ipeD(ipe,ipe^D) - IF(npeDknown .AND. .NOT.npeDinname)THEN + if(npeDknown .and. .not.npeDinname)then ! insert npe^D into name - i=INDEX(name,'.') + i=index(name,'.') nametail=name(i:^LENNAME) - WRITE(name(i:^LENNAME),"('_np',3i2.2)") npe^D + write(name(i:^LENNAME),"('_np',3i2.2)") npe^D i = i+3+2*^ND - ENDIF + endif ! insert ipe number into the filename - WRITE(name(i:^LENNAME),"('_',i3.3,a)") ipe,nametail(1:^LENNAME-i-4) + print*, filetype + if ((filetype .eq. 'outfile') .and. (.not. typefileout .eq. 'gdf')) then + write(name(i:^LENNAME),"('_',i3.3,a)") ipe,nametail(1:^LENNAME-i-4) + end if + + if ((filetype .eq. 'inifile') .and. (.not. typefileini .eq. 'gdf')) then + write(name(i:^LENNAME),"('_',i3.3,a)") ipe,nametail(1:^LENNAME-i-4) + end if ! Set logicals about MPI boundaries for this processor {^DLOOP mpiupperB(^D)=ipe^D0 \} - IF(oktest)WRITE(*,*)'mpisetnpeDipeD: ipe,npeD,ipeD,name=',ipe,npe^D,ipe^D,name + if(oktest)write(*,*)'mpisetnpeDipeD: ipe,npeD,ipeD,name=',ipe,npe^D,ipe^D,name - RETURN -END SUBROUTINE mpisetnpeDipeD + return +end subroutine mpisetnpeDipeD !============================================================================== -SUBROUTINE mpineighbors(idir,hpe,jpe) +subroutine mpineighbors(idir,hpe,jpe) ! Find the hpe and jpe processors on the left and right side of this processor ! in direction idir. The processor cube is taken to be periodic in every ! direction. - USE constants - USE common_variables + use constants + use common_variables - INTEGER :: idir,hpe,jpe,hpe^D,jpe^D + integer :: idir,hpe,jpe,hpe^D,jpe^D !----------------------------------------------------------------------------- hpe^D=ipe^D-kr(^D,idir); jpe^D=ipe^D+kr(^D,idir); {^DLOOP - IF(hpe^D<0)hpe^D=npe^D-1 - IF(jpe^D>=npe^D)jpe^D=0\} + if(hpe^D<0)hpe^D=npe^D-1 + if(jpe^D>=npe^D)jpe^D=0\} - CALL ipeD2ipe(hpe^D,hpe) - CALL ipeD2ipe(jpe^D,jpe) + call ipeD2ipe(hpe^D,hpe) + call ipeD2ipe(jpe^D,jpe) - RETURN -END SUBROUTINE mpineighbors + return +end subroutine mpineighbors !============================================================================== -SUBROUTINE mpigridsetup +subroutine mpigridsetup ! Distribute a grid of size nxall^D onto PE-s arranged in a cube of size npe^D - USE constants - USE common_variables + use constants + use common_variables !----------------------------------------------------------------------------- !!!write(*,*)'nxall,npe=',nxall^D,npe^D @@ -184,62 +194,62 @@ SUBROUTINE mpigridsetup ! The last processors in a direction may have smaller grid sizes than nxpe {^DLOOP - IF(ipe^D < npe^D-1)THEN + if(ipe^D < npe^D-1)then nx^D = nxpe^D - ELSE + else nx^D = nxall^D - ixpemin^D + 1 - ENDIF + endif \} ! Global grid index of the last grid point stored on this PE ixPEmax^D=ixPEmin^D+nx^D-1; - RETURN -END SUBROUTINE mpigridsetup + return +end subroutine mpigridsetup !============================================================================= -SUBROUTINE mpireduce(a,mpifunc) +subroutine mpireduce(a,mpifunc) ! reduce input for one PE 0 using mpifunc - USE constants + use constants - REAL(kind=8) :: a, alocal - INTEGER :: mpifunc, ierrmpi + real(kind=8) :: a, alocal + integer :: mpifunc, ierrmpi !---------------------------------------------------------------------------- alocal = a - CALL MPI_REDUCE(alocal,a,1,MPI_DOUBLE_PRECISION,mpifunc,& + call MPI_REDUCE(alocal,a,1,MPI_DOUBLE_PRECISION,mpifunc,& 0,MPI_COMM_WORLD,ierrmpi) - RETURN -END SUBROUTINE mpireduce + return +end subroutine mpireduce !============================================================================== -SUBROUTINE mpiallreduce(a,mpifunc) +subroutine mpiallreduce(a,mpifunc) ! reduce input onto all PE-s using mpifunc - USE constants + use constants - REAL(kind=8) :: a, alocal - INTEGER :: mpifunc, ierrmpi + real(kind=8) :: a, alocal + integer :: mpifunc, ierrmpi !----------------------------------------------------------------------------- alocal = a - CALL MPI_ALLREDUCE(alocal,a,1,MPI_DOUBLE_PRECISION,mpifunc,& + call MPI_ALLREDUCE(alocal,a,1,MPI_DOUBLE_PRECISION,mpifunc,& MPI_COMM_WORLD,ierrmpi) - RETURN -END SUBROUTINE mpiallreduce + return +end subroutine mpiallreduce !============================================================================== -SUBROUTINE mpiix(ix^D,jpe) +subroutine mpiix(ix^D,jpe) ! Convert ix^D physical cell index on the global grid to local indexes ! and set the processor number jpe to the processor that contains the cell - USE constants - USE common_variables - INTEGER :: ix^D, jpe, jpe^D + use constants + use common_variables + integer :: ix^D, jpe, jpe^D !----------------------------------------------------------------------------- ! Directional processor indexes @@ -249,83 +259,83 @@ SUBROUTINE mpiix(ix^D,jpe) ix^D=ix^D-jpe^D*nxpe^D; ! Get MPI processor index - CALL ipeD2ipe(jpe^D,jpe) + call ipeD2ipe(jpe^D,jpe) - RETURN -END SUBROUTINE mpiix + return +end subroutine mpiix !============================================================================== -SUBROUTINE mpiixlimits(ix^L) +subroutine mpiixlimits(ix^L) ! Convert global index limits to local index limits for this PE - USE constants - USE common_variables - INTEGER :: ix^L + use constants + use common_variables + integer :: ix^L !----------------------------------------------------------------------------- {^DLOOP - IF(ixmin^D > ixPEmax^D)THEN + if(ixmin^D > ixPEmax^D)then ixmin^D = nx^D ixmax^D = nx^D-1 - ELSEIF(ixmax^D < ixPEmin^D)THEN + elseif(ixmax^D < ixPEmin^D)then ixmax^D = 0 ixmin^D = 1 - ELSE - ixmin^D = MAX(ixmin^D,ixPEmin^D) - ixPEmin^D + 1 - ixmax^D = MIN(ixmax^D,ixPEmax^D) - ixPEmin^D + 1 - ENDIF + else + ixmin^D = max(ixmin^D,ixPEmin^D) - ixPEmin^D + 1 + ixmax^D = min(ixmax^D,ixPEmax^D) - ixPEmin^D + 1 + endif \} - RETURN -END SUBROUTINE mpiixlimits + return +end subroutine mpiixlimits !============================================================================== -SUBROUTINE mpistop(message) +subroutine mpistop(message) ! Stop MPI run in an orderly fashion - USE constants - USE common_variables + use constants + use common_variables - CHARACTER(*) :: message - INTEGER :: nerrmpi + character(*) :: message + integer :: nerrmpi !------------------------------------------------------------------------------ - WRITE(*,*)'ERROR for processor',ipe,':' - WRITE(*,*)message - CALL MPI_abort(MPI_COMM_WORLD, nerrmpi, ierrmpi) + write(*,*)'ERROR for processor',ipe,':' + write(*,*)message + call MPI_abort(MPI_COMM_WORLD, nerrmpi, ierrmpi) - STOP -END SUBROUTINE mpistop + stop +end subroutine mpistop !============================================================================== -SUBROUTINE mpibound(nvar,var) +subroutine mpibound(nvar,var) ! Fill in ghost cells of var(ixG,nvar) from other processors - USE constants - USE common_variables + use constants + use common_variables - INTEGER :: nvar - REAL(kind=8) :: var(ixG^T,nvar) + integer :: nvar + real(kind=8) :: var(ixG^T,nvar) ! processor indexes for left and right neighbors - INTEGER :: hpe,jpe + integer :: hpe,jpe ! index limits for the left and right side mesh and ghost cells - INTEGER :: ixLM^L, ixRM^L, ixLG^L, ixRG^L - LOGICAL :: periodic + integer :: ixLM^L, ixRM^L, ixLG^L, ixRG^L + logical :: periodic ! There can be at most 2 receives in any direction for each PE - INTEGER :: nmpirequest, mpirequests(2) - INTEGER :: mpistatus(MPI_STATUS_SIZE,2) - COMMON /mpirecv/ nmpirequest,mpirequests,mpistatus + integer :: nmpirequest, mpirequests(2) + integer :: mpistatus(MPI_STATUS_SIZE,2) + common /mpirecv/ nmpirequest,mpirequests,mpistatus !----------------------------------------------------------------------------- - oktest=INDEX(teststr,'mpibound')>0 - IF(oktest)WRITE(*,*)'mpibound ipe,nvar,varold=',& - ipe,nvar,var(ixtest^D,MIN(nvar,iwtest)) + oktest=index(teststr,'mpibound')>0 + if(oktest)write(*,*)'mpibound ipe,nvar,varold=',& + ipe,nvar,var(ixtest^D,min(nvar,iwtest)) {^DLOOP - IF(npe^D>1)THEN + if(npe^D>1)then nmpirequest =0 mpirequests(1:2) = MPI_REQUEST_NULL @@ -340,128 +350,128 @@ SUBROUTINE mpibound(nvar,var) ixRM^L=ixG^L; ixRMmax^D=ixMmax^D; ixRMmin^D=ixMmax^D-dixBmax^D+1; ! Obtain left and right neighbor processors for this direction - CALL mpineighbors(^D,hpe,jpe) + call mpineighbors(^D,hpe,jpe) - IF(oktest)THEN - WRITE(*,*)'mpibound ipe,idir=',ipe,^D - WRITE(*,*)'mpibound ipe,ixLG=',ipe,ixLG^L - WRITE(*,*)'mpibound ipe,ixRG=',ipe,ixRG^L - WRITE(*,*)'mpibound ipe,ixLM=',ipe,ixLM^L - WRITE(*,*)'mpibound ipe,ixRM=',ipe,ixRM^L - WRITE(*,*)'mpibound ipe,hpe,jpe=',ipe,hpe,jpe - ENDIF + if(oktest)then + write(*,*)'mpibound ipe,idir=',ipe,^D + write(*,*)'mpibound ipe,ixLG=',ipe,ixLG^L + write(*,*)'mpibound ipe,ixRG=',ipe,ixRG^L + write(*,*)'mpibound ipe,ixLM=',ipe,ixLM^L + write(*,*)'mpibound ipe,ixRM=',ipe,ixRM^L + write(*,*)'mpibound ipe,hpe,jpe=',ipe,hpe,jpe + endif ! receive right (2) boundary from left neighbor hpe - IF(mpilowerB(^D) .OR. periodic)CALL mpirecvbuffer(nvar,ixRM^L,hpe,2) + if(mpilowerB(^D) .or. periodic)call mpirecvbuffer(nvar,ixRM^L,hpe,2) ! receive left (1) boundary from right neighbor jpe - IF(mpiupperB(^D) .OR. periodic)CALL mpirecvbuffer(nvar,ixLM^L,jpe,1) + if(mpiupperB(^D) .or. periodic)call mpirecvbuffer(nvar,ixLM^L,jpe,1) ! Wait for all receives to be posted - CALL MPI_BARRIER(MPI_COMM_WORLD,ierrmpi) + call MPI_BARRIER(MPI_COMM_WORLD,ierrmpi) ! Ready send left (1) boundary to left neighbor hpe - IF(mpilowerB(^D) .OR. periodic)CALL mpisend(nvar,var,ixLM^L,hpe,1) + if(mpilowerB(^D) .or. periodic)call mpisend(nvar,var,ixLM^L,hpe,1) ! Ready send right (2) boundary to right neighbor - IF(mpiupperB(^D) .OR. periodic)CALL mpisend(nvar,var,ixRM^L,jpe,2) + if(mpiupperB(^D) .or. periodic)call mpisend(nvar,var,ixRM^L,jpe,2) ! Wait for messages to arrive - CALL MPI_WAITALL(nmpirequest,mpirequests,mpistatus,ierrmpi) + call MPI_WAITALL(nmpirequest,mpirequests,mpistatus,ierrmpi) ! Copy buffer received from right (2) physical cells into left ghost cells - IF(mpilowerB(^D) .OR. periodic)CALL mpibuffer2var(2,nvar,var,ixLG^L) + if(mpilowerB(^D) .or. periodic)call mpibuffer2var(2,nvar,var,ixLG^L) ! Copy buffer received from left (1) physical cells into right ghost cells - IF(mpiupperB(^D) .OR. periodic)CALL mpibuffer2var(1,nvar,var,ixRG^L) - ENDIF + if(mpiupperB(^D) .or. periodic)call mpibuffer2var(1,nvar,var,ixRG^L) + endif \} - IF(oktest)WRITE(*,*)'mpibound ipe,varnew=',ipe,var(ixtest^D,MIN(nvar,iwtest)) + if(oktest)write(*,*)'mpibound ipe,varnew=',ipe,var(ixtest^D,min(nvar,iwtest)) - RETURN -END SUBROUTINE mpibound + return +end subroutine mpibound !============================================================================== -SUBROUTINE mpisend(nvar,var,ix^L,qipe,iside) +subroutine mpisend(nvar,var,ix^L,qipe,iside) ! Send var(ix^L,1:nvar) to processor qipe. ! jside is 0 for min and 1 for max side of the grid for the sending PE - USE constants - USE common_variables + use constants + use common_variables - INTEGER :: nvar - REAL(kind=8) :: var(ixG^T,nvar) - INTEGER :: ix^L, qipe, iside, n, ix^D, ivar + integer :: nvar + real(kind=8) :: var(ixG^T,nvar) + integer :: ix^L, qipe, iside, n, ix^D, ivar !---------------------------------------------------------------------------- - oktest = INDEX(teststr,'mpisend')>0 + oktest = index(teststr,'mpisend')>0 n=0 - DO ivar=1,nvar - {DO ix^DB=ixmin^DB,ixmax^DB;} + do ivar=1,nvar + {do ix^DB=ixmin^DB,ixmax^DB;} n=n+1 sendbuffer(n)=var(ix^D,ivar) - {ENDDO^DLOOP\} - END DO + {enddo^DLOOP\} + end do - IF(oktest)THEN - WRITE(*,*)'mpisend ipe-->qipe,iside,itag',ipe,qipe,iside,10*ipe+iside - WRITE(*,*)'mpisend ipe,ix^L,var=',ipe,ix^L,var(ixtest^D,MIN(iwtest,nvar)) - ENDIF + if(oktest)then + write(*,*)'mpisend ipe-->qipe,iside,itag',ipe,qipe,iside,10*ipe+iside + write(*,*)'mpisend ipe,ix^L,var=',ipe,ix^L,var(ixtest^D,min(iwtest,nvar)) + endif - CALL MPI_RSEND(sendbuffer(1),n,MPI_DOUBLE_PRECISION,qipe,10*ipe+iside,& + call MPI_RSEND(sendbuffer(1),n,MPI_DOUBLE_PRECISION,qipe,10*ipe+iside,& MPI_COMM_WORLD,ierrmpi) - RETURN -END SUBROUTINE mpisend + return +end subroutine mpisend !============================================================================== -SUBROUTINE mpirecvbuffer(nvar,ix^L,qipe,iside) +subroutine mpirecvbuffer(nvar,ix^L,qipe,iside) ! receive buffer for a ghost cell region of size ix^L sent from processor qipe ! and sent from side iside of the grid - USE constants - USE common_variables + use constants + use common_variables - INTEGER:: nvar, ix^L, qipe, iside, n + integer:: nvar, ix^L, qipe, iside, n - INTEGER :: nmpirequest, mpirequests(2) - INTEGER :: mpistatus(MPI_STATUS_SIZE,2) - COMMON /mpirecv/ nmpirequest,mpirequests,mpistatus + integer :: nmpirequest, mpirequests(2) + integer :: mpistatus(MPI_STATUS_SIZE,2) + common /mpirecv/ nmpirequest,mpirequests,mpistatus !---------------------------------------------------------------------------- - oktest = INDEX(teststr,'mpirecv')>0 + oktest = index(teststr,'mpirecv')>0 n = nvar* ^D&(ixmax^D-ixmin^D+1)* - IF(oktest)WRITE(*,*)'mpirecv ipe<--qipe,iside,itag,n',& + if(oktest)write(*,*)'mpirecv ipe<--qipe,iside,itag,n',& ipe,qipe,iside,10*qipe+iside,n nmpirequest = nmpirequest + 1 - CALL MPI_IRECV(recvbuffer(1,iside),n,MPI_DOUBLE_PRECISION,qipe,10*qipe+iside,& + call MPI_IRECV(recvbuffer(1,iside),n,MPI_DOUBLE_PRECISION,qipe,10*qipe+iside,& MPI_COMM_WORLD,mpirequests(nmpirequest),ierrmpi) - RETURN -END SUBROUTINE mpirecvbuffer + return +end subroutine mpirecvbuffer !============================================================================== -SUBROUTINE mpibuffer2var(iside,nvar,var,ix^L) +subroutine mpibuffer2var(iside,nvar,var,ix^L) ! Copy mpibuffer(:,iside) into var(ix^L,1:nvar) - USE constants - USE common_variables + use constants + use common_variables - INTEGER :: nvar - REAL(kind=8):: var(ixG^T,nvar) - INTEGER:: ix^L,iside,n,ix^D,ivar + integer :: nvar + real(kind=8):: var(ixG^T,nvar) + integer:: ix^L,iside,n,ix^D,ivar !----------------------------------------------------------------------------- - oktest = INDEX(teststr,'buffer2var')>0 + oktest = index(teststr,'buffer2var')>0 n=0 - DO ivar=1,nvar - {DO ix^DB=ixmin^DB,ixmax^DB;} + do ivar=1,nvar + {do ix^DB=ixmin^DB,ixmax^DB;} n=n+1 var(ix^D,ivar)=recvbuffer(n,iside) - {ENDDO^DLOOP\} - END DO + {enddo^DLOOP\} + end do - IF(oktest)WRITE(*,*)'buffer2var: ipe,iside,ix^L,var',& - ipe,iside,ix^L,var(ixtest^D,MIN(iwtest,nvar)) + if(oktest)write(*,*)'buffer2var: ipe,iside,ix^L,var',& + ipe,iside,ix^L,var(ixtest^D,min(iwtest,nvar)) - RETURN -END SUBROUTINE mpibuffer2var + return +end subroutine mpibuffer2var diff --git a/sac/src/vacpp.pl b/sac/src/vacpp.pl index 0c203f3..c9a683d 100755 --- a/sac/src/vacpp.pl +++ b/sac/src/vacpp.pl @@ -17,7 +17,7 @@ $phi=-9; $z=-8; $if_cd=1; $if_mc=0; $if_fct=0; $if_tvdlf=0; $if_tvd=0; $if_impl=0; $if_poisson=0; $if_ct=0; $if_gencoord=0; $if_resist=0; $if_rk=1; -$if_mpi=0; +$if_mpi=1; # SETVAC READS UP TO THIS POINT From d88ab2a151d4640364f8461e096d04fc994e85bc Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Sat, 4 Oct 2014 15:11:11 +0100 Subject: [PATCH 22/32] more progress with parallel write. The main dataset write now seems to be working. However domain_left_edge and domain_right_edge are not yet correct. Also general testing has not poven successful. --- sac/src/vacio.t | 36 +++++++++++++++++++----------------- sac/src/vacmpi.t | 6 +++--- 2 files changed, 22 insertions(+), 20 deletions(-) diff --git a/sac/src/vacio.t b/sac/src/vacio.t index 890babd..96f3d81 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -15,7 +15,8 @@ subroutine readparameters(w) real(kind=8):: w(ixG^T,nw) - character(^LENTYPE):: typepred(nw),typefull(nw),typeimpl(nw),typefilter(nw) + character(^LENTYPE):: typepred(nw),typefull(nw),typeimpl(nw),typefilter(nw), mpifiletype + real(kind=8):: muscleta integer:: i,j,k,iw,idim,iB,ifile,isave logical:: implmrpc,globalixtest^IFMPI @@ -192,8 +193,10 @@ subroutine readparameters(w) {^IFMPI ! Extract and check the directional processor numbers and indexes ! and concat the PE number to the input and output filenames - call mpisetnpeDipeD(filenameini, 'inifile') - call mpisetnpeDipeD(filename(fileout_), 'outfile') + mpifiletype = 'inifile' + call mpisetnpeDipeD(filenameini, mpifiletype) + mpifiletype = 'outfile' + call mpisetnpeDipeD(filename(fileout_), mpifiletype) } if(oktest) then @@ -1243,9 +1246,12 @@ subroutine savefileout_gdf(w,ix^L) gdf_nx = (/ 1, 1, 1 /) gdf_nx(:^ND) = (/ ixmax^D-ixmin^D+1 /) + file_dims = gdf_nx + {^IFMPI {file_dims(^D) = (ixmax^D-ixmin^D+1) * npe^D; }} + print*, file_dims print*, "savefile_gdf" - print*, gdf_nx - print*, ix^L + print*, ipe, gdf_nx + print*, ipe, ix^L allocate(wdata3D(1:gdf_nx(1), 1:gdf_nx(2), 1:gdf_nx(3))) print*, shape(wdata3D) @@ -1266,7 +1272,7 @@ subroutine savefileout_gdf(w,ix^L) gdf_sp%cosmological_simulation = 0 gdf_sp%current_time = t gdf_sp%dimensionality = ^ND - gdf_sp%domain_dimensions = gdf_nx ! on disk + gdf_sp%domain_dimensions = file_dims ! on disk gdf_sp%domain_left_edge = (/ 0, 0, 0 /) gdf_sp%domain_right_edge = (/ 1, 1, 1 /) gdf_sp%domain_left_edge(:^ND) = x(ixmin^D, :) !bottom left corner @@ -1281,7 +1287,7 @@ subroutine savefileout_gdf(w,ix^L) rd%grid_parent_id = 0 rd%grid_left_index(:, 1) = (/ 0, 0 /) - rd%grid_dimensions(:, 1) = gdf_nx + rd%grid_dimensions(:, 1) = file_dims rd%grid_level = 0 rd%grid_particle_count(:, 1) = (/ 0 /) @@ -1299,23 +1305,19 @@ subroutine savefileout_gdf(w,ix^L) !Calculate offset and count offset = (/ 0, 0, 0 /) count = (/ 1, 1, 1 /) - {count(^D) = ixmax^D; } - file_dims = (/ 1, 1, 1 /) - {file_dims(^D) = ixmax^D * npe^D; } - print*, file_dims + {count(^D) = ixmax^D-ixmin^D+1; } ! If we are not in MPI mode use the default xfer_prp - xfer_prp = H5P_DEFAULT_F + call h5pcreate_f(H5P_DATASET_XFER_F, xfer_prp, error) {^IFMPI - {offset(^D) = ixmax^D * ipe^D; } - {count(^D) = ixmax^D; } + {offset(^D) = (ixmax^D-ixmin^D+1) * ipe^D; } + {count(^D) = ixmax^D-ixmin^D+1; } ! Create property list for collective dataset write - call h5pcreate_f(H5P_DATASET_XFER_F, xfer_prp, error) - call h5pset_dxpl_mpio_f(xfer_prp, H5FD_MPIO_COLLECTIVE_F, error) + !call h5pcreate_f(H5P_DATASET_XFER_F, xfer_prp, error) + !call h5pset_dxpl_mpio_f(xfer_prp, H5FD_MPIO_COLLECTIVE_F, error) } - call h5pcreate_f(H5P_DATASET_XFER_F, xfer_prp, error) call sacgdf_write_datasets(doml_g_id, w, ix^L, xfer_prp, file_dims, offset, count) call h5fclose_f(file_id, error) diff --git a/sac/src/vacmpi.t b/sac/src/vacmpi.t index a2f2fea..478c75f 100644 --- a/sac/src/vacmpi.t +++ b/sac/src/vacmpi.t @@ -73,7 +73,8 @@ subroutine mpisetnpeDipeD(name, filetype) implicit none - character(^LENNAME), intent(inout) :: name, filetype + character(^LENNAME), intent(inout) :: name + character(^LENTYPE), intent(in) :: filetype character(^LENNAME) :: nametail integer:: i,qnpe^D logical:: npeDknown,npeDinname @@ -132,8 +133,7 @@ subroutine mpisetnpeDipeD(name, filetype) i = i+3+2*^ND endif - ! insert ipe number into the filename - print*, filetype + ! insert ipe number into the filename, only if not using gdf files. if ((filetype .eq. 'outfile') .and. (.not. typefileout .eq. 'gdf')) then write(name(i:^LENNAME),"('_',i3.3,a)") ipe,nametail(1:^LENNAME-i-4) end if From 3f6201556d43da49b6614fa32fc42c1343d89b45 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Mon, 6 Oct 2014 14:35:07 +0100 Subject: [PATCH 23/32] Add mpi configs for testing gdf --- sac/par/binoutmpi | 52 +++++++++++++++++++++++++++++++++++++++++++++++ sac/par/gdfoutmpi | 52 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 104 insertions(+) create mode 100644 sac/par/binoutmpi create mode 100644 sac/par/gdfoutmpi diff --git a/sac/par/binoutmpi b/sac/par/binoutmpi new file mode 100644 index 0000000..12749fa --- /dev/null +++ b/sac/par/binoutmpi @@ -0,0 +1,52 @@ +&testlist + teststr='readfileini' +/ + +&filelist + filenameini='/archive/gdf_testing/mhdmodes_np0202.ini' + + typefileini='binary' + filename= '/archive/gdf_testing/mhdmodes_np0202.log', + '/archive/gdf_testing/mhdmodes_np0202.out' + typefileout='binary' + fullgridout= F + fullgridini= T + / + +&savelist + dtsave = 1,0.1 + itsave(1,2)=0 + + / + + &stoplist + tmax=0.2d0 + itmax = 10000 + / + + &methodlist + + wnames= 'h m1 m2 e b1 b2 eb rhob bg1 bg2' + typefull= 6*'cd4',4*'nul' + typeadvance= 'onestep' + typefilter= 10*'nul' + dimsplit= F + sourcesplit= F + divBfix= F + smallp= 10.d0 + / + + &boundlist + typeB= 10*'fixed' + 10*'fixed' + 10*'fixed' + 10*'fixed' + 10*'fixed' + 10*'fixed' + + / + + ¶mlist + courantpar=0.2 + + / diff --git a/sac/par/gdfoutmpi b/sac/par/gdfoutmpi new file mode 100644 index 0000000..8dc34d3 --- /dev/null +++ b/sac/par/gdfoutmpi @@ -0,0 +1,52 @@ +&testlist + teststr='readfileini' +/ + +&filelist + filenameini='/archive/gdf_testing/mhdmodes_np0202.ini' + + typefileini='binary' + filename= '/archive/gdf_testing/mhdmodes_np0202.log', + '/archive/gdf_testing/mhdmodes_np0202_' + typefileout='gdf' + fullgridout= F + fullgridini= T + / + +&savelist + dtsave = 1,0.1 + itsave(1,2)=0 + + / + + &stoplist + tmax=0.2d0 + itmax = 10000 + / + + &methodlist + + wnames= 'h m1 m2 e b1 b2 eb rhob bg1 bg2' + typefull= 6*'cd4',4*'nul' + typeadvance= 'onestep' + typefilter= 10*'nul' + dimsplit= F + sourcesplit= F + divBfix= F + smallp= 10.d0 + / + + &boundlist + typeB= 10*'fixed' + 10*'fixed' + 10*'fixed' + 10*'fixed' + 10*'fixed' + 10*'fixed' + + / + + ¶mlist + courantpar=0.2 + + / From d1d4ad9e1e9e5ea01cc1326913438f214bb85871 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Tue, 28 Oct 2014 11:30:29 +0000 Subject: [PATCH 24/32] Change submodule to SWAT fork --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index b12429c..39fc107 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,3 @@ [submodule "sac/src/fgdfio"] path = sac/src/fgdfio - url = https://github.com/Cadair/fgdfio.git + url = https://github.com/SWAT-Sheffield/fgdfio.git From c6e6aed015fe094491c518813f2e16d2f9d9bbf0 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Tue, 7 Oct 2014 15:38:09 +0100 Subject: [PATCH 25/32] update fgdfio --- sac/src/fgdfio | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sac/src/fgdfio b/sac/src/fgdfio index cdddd1d..f00c5cd 160000 --- a/sac/src/fgdfio +++ b/sac/src/fgdfio @@ -1 +1 @@ -Subproject commit cdddd1d88433a43ebc57fe6a39480c11ca084f01 +Subproject commit f00c5cde92d76292bff78a7a7a8646a9ee8b4c18 From 00bc15171f0322277dfd02e989a8c5cf154e0db3 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Tue, 7 Oct 2014 15:38:24 +0100 Subject: [PATCH 26/32] Update makefile to use env vars --- sac/src/Makefile | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/sac/src/Makefile b/sac/src/Makefile index 2ed0b48..7df3576 100644 --- a/sac/src/Makefile +++ b/sac/src/Makefile @@ -1,8 +1,7 @@ # This is a VERY striped down makefile for compiling sac with gfortran - -# Check to see if the ENV variables are defined for the compiler +# This will become a SAC only f2py makefile hopefully ifndef F90 - F90=mpif90 + F90=h5pfc endif ifndef F90FLG F90FLG=-std=f2008 @@ -37,8 +36,8 @@ VAC_OBJ = vac$O vacio$O vacgrid$O vacphys0$O vacphys$O vacusr$O # The VACCD, VACMC, VACFCT, VACTVDLF, VACTVD, VACIMPL, VACPOISSON, VACMPI # modules are removed or added in the following two lines by "setvac". # DO NOT TOUCH THESE TWO LINES: -VACFOR = $(VAC_FOR) vaccd$F vacmpi$F -VACOBJ = $(VAC_OBJ) vaccd$O vacmpi$O +VACFOR = $(VAC_FOR) vaccd$F +VACOBJ = $(VAC_OBJ) vaccd$O ROEOBJ = roetest$O vacphys0$O vacphys$O From af071f03d4ab499e5f141882a37a9b5fafc1bbab Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Tue, 7 Oct 2014 15:39:11 +0100 Subject: [PATCH 27/32] remove mpi prints --- sac/src/vacio.t | 5 ----- 1 file changed, 5 deletions(-) diff --git a/sac/src/vacio.t b/sac/src/vacio.t index 96f3d81..a41fe65 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -1248,13 +1248,8 @@ subroutine savefileout_gdf(w,ix^L) gdf_nx(:^ND) = (/ ixmax^D-ixmin^D+1 /) file_dims = gdf_nx {^IFMPI {file_dims(^D) = (ixmax^D-ixmin^D+1) * npe^D; }} - print*, file_dims - print*, "savefile_gdf" - print*, ipe, gdf_nx - print*, ipe, ix^L allocate(wdata3D(1:gdf_nx(1), 1:gdf_nx(2), 1:gdf_nx(3))) - print*, shape(wdata3D) ! Open file call h5open_f(error) From d2af9c0014ee2f405ec5b282834228554f8236a1 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Fri, 17 Oct 2014 11:03:07 +0100 Subject: [PATCH 28/32] update changes to fgdfio --- sac/src/fgdfio | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sac/src/fgdfio b/sac/src/fgdfio index f00c5cd..85fdb72 160000 --- a/sac/src/fgdfio +++ b/sac/src/fgdfio @@ -1 +1 @@ -Subproject commit f00c5cde92d76292bff78a7a7a8646a9ee8b4c18 +Subproject commit 85fdb721366390a9af23f9f7260de6c941aa359f From 80803b1bac43bbfbf47806f97898fb0ac7727aea Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Fri, 17 Oct 2014 11:04:03 +0100 Subject: [PATCH 29/32] updates, now saving edges out in parallel properly --- sac/par/gdfini | 6 +++--- sac/par/gdfout | 6 +++--- sac/par/gdfoutmpi | 2 +- sac/src/Makefile | 4 ++-- sac/src/vacdef.t | 3 +++ sac/src/vacio.t | 32 +++++++++++++++++++++++++++----- 6 files changed, 39 insertions(+), 14 deletions(-) diff --git a/sac/par/gdfini b/sac/par/gdfini index 6502323..f106f03 100644 --- a/sac/par/gdfini +++ b/sac/par/gdfini @@ -3,11 +3,11 @@ / &filelist - filenameini='/home/cs1sjm/gdf_testing/mhdmodes_2D_00000000.gdf' + filenameini='/archive/gdf_testing/mhdmodes_2D_00000000.gdf' typefileini='gdf' - filename= '/home/cs1sjm/gdf_testing/mhdmodes_2D.log', - '/home/cs1sjm/gdf_testing/mhdmodes_2D_ii_' + filename= '/archive/gdf_testing/mhdmodes_2D.log', + '/archive/gdf_testing/mhdmodes_2D_ii_' typefileout='gdf' fullgridout= F fullgridini= F diff --git a/sac/par/gdfout b/sac/par/gdfout index c386dde..855098a 100644 --- a/sac/par/gdfout +++ b/sac/par/gdfout @@ -3,11 +3,11 @@ / &filelist - filenameini='/home/cs1sjm/gdf_testing/mhdmodes_2D.ini' + filenameini='/archive/gdf_testing/mhdmodes_2D.ini' typefileini='binary' - filename= '/home/cs1sjm/gdf_testing/mhdmodes_2D.log', - '/home/cs1sjm/gdf_testing/mhdmodes_2D_' + filename= '/archive/gdf_testing/mhdmodes_2D.log', + '/archive/gdf_testing/mhdmodes_2D_' typefileout='gdf' fullgridout= F fullgridini= T diff --git a/sac/par/gdfoutmpi b/sac/par/gdfoutmpi index 8dc34d3..62cc29f 100644 --- a/sac/par/gdfoutmpi +++ b/sac/par/gdfoutmpi @@ -1,5 +1,5 @@ &testlist - teststr='readfileini' + teststr='' / &filelist diff --git a/sac/src/Makefile b/sac/src/Makefile index 7df3576..4c253dd 100644 --- a/sac/src/Makefile +++ b/sac/src/Makefile @@ -36,8 +36,8 @@ VAC_OBJ = vac$O vacio$O vacgrid$O vacphys0$O vacphys$O vacusr$O # The VACCD, VACMC, VACFCT, VACTVDLF, VACTVD, VACIMPL, VACPOISSON, VACMPI # modules are removed or added in the following two lines by "setvac". # DO NOT TOUCH THESE TWO LINES: -VACFOR = $(VAC_FOR) vaccd$F -VACOBJ = $(VAC_OBJ) vaccd$O +VACFOR = $(VAC_FOR) vaccd$F vacmpi$F +VACOBJ = $(VAC_OBJ) vaccd$O vacmpi$O ROEOBJ = roetest$O vacphys0$O vacphys$O diff --git a/sac/src/vacdef.t b/sac/src/vacdef.t index 62cba82..487d67c 100644 --- a/sac/src/vacdef.t +++ b/sac/src/vacdef.t @@ -121,6 +121,9 @@ module common_variables !Grid parameters INTEGER:: ixM^L,ixG^L,nx^D,nx(ndim) INTEGER:: dixB^L + + ! Global x array edges + real(kind=8), dimension(3) :: x_left_edge = (/ 0, 0, 0 /), x_right_edge = (/ 1, 1, 1 /) ! x and dx are local for HPF REAL(kind=8):: x(IXG^T,ndim),dx(IXG^T,ndim) REAL(kind=8):: volume,dvolume(IXG^T) diff --git a/sac/src/vacio.t b/sac/src/vacio.t index a41fe65..c47e6e9 100644 --- a/sac/src/vacio.t +++ b/sac/src/vacio.t @@ -550,6 +550,7 @@ subroutine readfileini(w) use constants use common_variables + implicit none real(kind=8):: w(ixG^T,nw) @@ -602,6 +603,24 @@ subroutine readfileini(w) return end subroutine readfileini +subroutine calculate_x_edges(ix^L) + ! Calculate the value of the very far left and very far right corner of the coordinate array, in all dimensions. + ! If we are using a non-gdf input file we need to broadcast this information to all the processes. + use common_variables, only: x, x_left_edge, x_right_edge {^IFMPI , npe, MPI_DOUBLE, MPI_COMM_WORLD, ierrmpi} + implicit none + + integer, intent(IN) :: ix^L + + x_left_edge(1:^ND) = x(ixmin^D, :) + x_right_edge(1:^ND) = x(ixmax^D, :) + + {^IFMPI + call MPI_Bcast(x_left_edge, 3, MPI_DOUBLE, 0, MPI_COMM_WORLD, ierrmpi) + call MPI_Bcast(x_right_edge, 3, MPI_DOUBLE, npe-1, MPI_COMM_WORLD, ierrmpi) + } + +end subroutine calculate_x_edges + !============================================================================= subroutine readfileini_asc(w) @@ -671,6 +690,7 @@ subroutine readfileini_asc(w) read(unitini,*,iostat=ios)(x(ix^D,idim),idim=1,ndim),& (w(ix^D,iw),iw=1,nwin),(wextra,iw=nwin+1,nwini) {end do^D&\} + call calculate_x_edges(ix^L) if(ios/=0)then write(uniterr,*)'Stop: iostat=',ios call die('Error in reading file') @@ -762,6 +782,7 @@ subroutine readfileini_bin(w) ! Read x array read(unitini,iostat=ios)(x(ix^S,idim),idim=1,ndim) + call calculate_x_edges(ix^L) ! Read w array ! To conform savefileout_bin we use loop for iw @@ -793,7 +814,7 @@ subroutine readfileini_gdf(w) use gdf, only: gdf_parameters_T, gdf_root_datasets_T, gdf_field_type_T use hdf5, only: h5open_f, h5gopen_f, h5fopen_f, h5fclose_f, h5close_f, HID_T, H5F_ACC_RDONLY_F use sacgdf, only: sacgdf_read_file, build_x_array, sacgdf_read_datasets - use common_variables, only: ixGlo^D, ixGhi^D, nw, filenameini, nx, x, t, gencoord, fileheadini, unitterm, teststr + use common_variables, only: ixGlo^D, ixGhi^D, nw, filenameini, nx, x, t, gencoord, fileheadini, unitterm, teststr, x_left_edge, x_right_edge implicit none @@ -855,6 +876,9 @@ subroutine readfileini_gdf(w) ! Build the x array call build_x_array(ix^L, disk_nx, gdf_sp%domain_left_edge(:ndimini), gdf_sp%domain_right_edge(:ndimini), x) + ! Save the global left and right corners + x_left_edge = gdf_sp%domain_left_edge + x_right_edge = gdf_sp%domain_right_edge ! Reconstruct the w array ! Create field groups @@ -1268,10 +1292,8 @@ subroutine savefileout_gdf(w,ix^L) gdf_sp%current_time = t gdf_sp%dimensionality = ^ND gdf_sp%domain_dimensions = file_dims ! on disk - gdf_sp%domain_left_edge = (/ 0, 0, 0 /) - gdf_sp%domain_right_edge = (/ 1, 1, 1 /) - gdf_sp%domain_left_edge(:^ND) = x(ixmin^D, :) !bottom left corner - gdf_sp%domain_right_edge(:^ND) = x(ixmax^D, :) ! top right corner + gdf_sp%domain_left_edge = x_left_edge + gdf_sp%domain_right_edge = x_right_edge gdf_sp%field_ordering = 1 gdf_sp%num_ghost_zones = 0 !on disk gdf_sp%refine_by = 0 From bad75521bf7f665a4e06804a12d1f077ee2d7dcb Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Tue, 28 Oct 2014 11:37:00 +0000 Subject: [PATCH 30/32] update fgdfio --- sac/src/fgdfio | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sac/src/fgdfio b/sac/src/fgdfio index 85fdb72..c66a789 160000 --- a/sac/src/fgdfio +++ b/sac/src/fgdfio @@ -1 +1 @@ -Subproject commit 85fdb721366390a9af23f9f7260de6c941aa359f +Subproject commit c66a789eacd9d65beae8d7cf217b35c351ca111f From cc26ef1fc9d95039f462989c0e1d82a8b35da216 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Tue, 28 Oct 2014 13:33:23 +0000 Subject: [PATCH 31/32] Add vacini back in for good measure. @mikeg64 --- sac/src/Makefile | 10 + sac/src/vacini.t | 1014 ++++++++++++++++++++++++++++++++++++++++++++++ sac/vacini | 1 + 3 files changed, 1025 insertions(+) create mode 120000 sac/vacini diff --git a/sac/src/Makefile b/sac/src/Makefile index 4c253dd..81fad66 100644 --- a/sac/src/Makefile +++ b/sac/src/Makefile @@ -39,6 +39,11 @@ VAC_OBJ = vac$O vacio$O vacgrid$O vacphys0$O vacphys$O vacusr$O VACFOR = $(VAC_FOR) vaccd$F vacmpi$F VACOBJ = $(VAC_OBJ) vaccd$O vacmpi$O +# The VACMPI module is removed or added the following two lines by "setvac". +# DO NOT TOUCH THESE TWO LINES: +VACINIFOR = vacini$F vacio$F vacphys0$F vacusr$F vacmpi$F +VACINIOBJ = vacini$O vacio$O vacphys0$O vacusr$O vacmpi$O + ROEOBJ = roetest$O vacphys0$O vacphys$O ################### Translation and dependency rules ####################### @@ -52,6 +57,7 @@ $(VACFOR) vacini$F vacdef$F vacpar$F vacusrpar$F sacgdf$F : $(PREPROC) roetest$F : $(PREPROC) $(VACOBJ) vacini$O vacall$O vaciniall$O vacsmall$O roetest$O sacgdf$0 : $(INCLUDES) +$(VACINIOBJ) vacini$O vacall$O vaciniall$O vacsmall$O roetest$O sacgdf$0 : $(INCLUDES) vacusrpar$F: vacusrpar.t $(VACPP) $< $(PREFOR) > $@ @@ -85,6 +91,10 @@ vacgrid$F: vacgrid.t gdf : $(FOR) $(FORFLG) -c $(GDF_INCLUDES) +# The "vacini" and "vac" targets use the default Fortran compiler +vacini : gdf $(VACINIOBJ) $(LIBS_) + $(FOR) $(FORFLG) -o $(VACDIR)/vacini $(GDF_INCLUDES) $(VACINIOBJ) $(LIBS) + vac : gdf $(VACOBJ) $(LIBS_) $(FOR) $(FORFLG) -o $(VACDIR)/vac $(GDF_INCLUDES) $(VACOBJ) $(LIBS) diff --git a/sac/src/vacini.t b/sac/src/vacini.t index e69de29..48e8fce 100644 --- a/sac/src/vacini.t +++ b/sac/src/vacini.t @@ -0,0 +1,1014 @@ +!############################################################################## +! module vacini + +!INCLUDE:vacnul.process.t +!============================================================================= +program vacini + +use constants + use common_variables + +integer:: iw,ieqpar,ix^L +character*20 :: typeini +double precision:: w(ixG^T,1:nw),wpar(nw) +logical:: lastiw +!----------------------------------------------------------------------------- +{call mpiinit ^IFMPI} + +verbose=.true. .and.ipe==0^IFMPI +if(verbose)then + write(*,'(a)')'VACINI 4.52 configured to' + write(*,'(a)')' -d=33 -phi=0 -z=0 -g=196,54,54 -p= -u=' + write(*,'(a)')' -on=cd,rk,mpi' + write(*,'(a)')' -off=mc,fct,tvdlf,tvd,impl,poisson,ct,gencoord,resist' + {^IFMPI write(*,'(a,i3,a)')'Running on ',npe,' processors'} +endif + +! Some default values +t=zero; it=0; +typefileout='ascii'; typefileini='auto' +snapshotini=0 +fullgridini=.false.; fullgridout=.false. +gencoord= .false. +! There are no ghost cells in VACINI except when "readmesh" is used. +dixB^L=0; ixMmin^D=ixGlo^D; +! Test cell +ixtest^D=ixMmin^D; +! Read parameters from STDIN +unitpar=unitstdin + +{^IFMPI +! MPI reads from a file +unitpar=unitini-1 +open(unitpar,file='vacini.par',status='old') +} + +if(verbose)write(*,*)'Filename for new initial file:' +read(unitpar,'(a)')filename(fileout_) +{^IFMPI +! Extract and check the directional processor numbers and indexes +! and concat the PE number to the output filename +call mpisetnpeDipeD(filename(fileout_)) +} +if(verbose)write(*,*)'Fileheader:' +read(unitpar,'(a)')fileheadout +if(verbose)write(*,*)'Variable names, e.g. "x y rho m1 m2":' +read(unitpar,'(a)')varnames + +call setheaderstrings + +if(verbose)then + write(*,*)'Select action by typing one of the following words: ' + write(*,*)' test' + write(*,*)' typefileini,snapshotini,read,readmesh,readnext,',& + 'typefileout,write,save' + write(*,*)' domain,grid,sheargrid,shiftgrid,polargrid,',& + 'roundgrid,rotategrid' + write(*,*)' transpose,regrid,stretchgrid,stretchgridcent' + write(*,*)' polarvar,spherevar,cartesian,rotatevar,',& + 'setvar,perturbvar,conserve,primitive,multiply,divide' + write(*,*)' uniform,shocktube,wave,wave1,special' + write(*,*)' eqpar,gencoord' +endif + +do + if(verbose)write(*,*)'Action:' + read(unitpar,'(a)')typeini + if(verbose)write(*,*)'> ',typeini + select case(typeini) + case('verbose') + if(verbose)write(*,*)'Verbose:' + read(unitpar,*)verbose + verbose=verbose.and.ipe==0^IFMPI + case('test') + if(verbose)write(*,*)'Teststring:' + read(unitpar,'(a)')teststr + if(verbose)write(*,*)'ixtest, idimtest and iwtest:' + read(unitpar,*) ixtest^D,idimtest,iwtest + {^IFMPI + call mpiix(ixtest^D,ipetest)} + case('typefileini') + if(verbose)write(*,*)'Type of old initial file: ascii/binary/special' + read(unitpar,'(a)')typefileini + case('snapshotini') + if(verbose)write(*,*)'Number of snapshot to be read:' + read(unitpar,*)snapshotini + case('read','readmesh') + if(verbose)write(*,*)'Filename for old initial file:' + read(unitpar,'(a)')filenameini + {call mpisetnpeDipeD(filenameini) ^IFMPI} + if(typeini=='readmesh')then + if(verbose)write(*,*)& + 'Specify boundary width for old initial file:' + read(unitpar,*) dixB^L + fullgridini=.true. + endif + call readfileini(w) + case('readnext') + snapshotini=snapshotini+1 + call readfileini(w) + case('typefileout') + if(verbose)write(*,*)'Type of new initial file: ascii/binary/special' + read(unitpar,'(a)')typefileout + case('write') + call savefile(fileout_,w) + case('save') + call savefile(fileout_,w) + close(unitini+fileout_) + exit + case('grid') + call ini_grid(.true.,ixM^L) + case('domain') + call ini_grid(.false.,ixM^L) + case('shiftgrid') + {^IFMPI call die('shiftgrid not implemented for MPI')} + call shiftgrid(ixM^L,w) + case('sheargrid') + {^IFMPI call die('sheargrid not implemented for MPI')} + call sheargrid(ixM^L,w) + case('polargrid') + {^NOONED call makepolargrid(ixM^L) + gencoord=.true. + if(.false.)}call die('Polar grid is meaningless in 1D') + case('spheregrid') + {^IFTHREED call spheregrid(ixM^L) + gencoord=.true. + if(.false.)}call die('Spherical grid is meaningful in 3D only') + case('roundgrid') + {^NOONED call roundgrid(ixM^L) + gencoord=.true. + if(.false.)}call die('Round grid is meaningless in 1D') + case('rotategrid') + call rotatevar(ixM^L,1,ndim,x) + gencoord=.true. + case('transpose') + {^IFMPI call die('transposexy not implemented for MPI')} + {^IFTWOD call transposexy(ixM^L,w) + if(.false.)}call die('Transpose is implemented in 2D only.') + case('regrid') + {^IFMPI call die('regrid not implemented for MPI')} + call regrid(ixM^L,w) + case('stretchgrid') + {^IFMPI call die('stretchgrid not yet implemented for MPI')} + call stretchgrid(.true.,ixM^L) + case('stretchgridcent') + {^IFMPI call die('stretchgridcent not yet implemented for MPI')} + call stretchgrid(.false.,ixM^L) + case('polarvar') + {^NOONED call polarvar(ixM^L,w) + if(.false.)}call die('Polar variables are meaningless in 1D') + case('spherevar') + {^IFTHREED call spherevar(ixM^L,w) + if(.false.)}call die('Spherical variables are meaningful '// & + 'in 3D only') + case('cartesian') + {^NOONED call cartesian(ixM^L,w) + if(.false.)} call die('Polar variables are meaningless in 1D') + case('rotatevar') + call rotatevar(ixM^L,1,nw,w) + case('setvar') + if(verbose)write(*,*)'Give ix limits:' + read(unitpar,*) ix^L + {^IFMPI + call mpiixlimits(ix^L)} + do + if(verbose)write(*,*) & + 'Variable index, variable value, lastiw (T/F)?' + read(unitpar,*)iw,wpar(iw),lastiw + w(ix^S,iw)=wpar(iw) + if(lastiw)exit + enddo + case('perturbvar') + call perturbvar(ixM^L,w) + case('multiply') + if(verbose)write(*,*)'Give multiplying factors for each variable:' + read(unitpar,*) wpar(1:nw) + do iw=1,nw + w(ixM^S,iw)=w(ixM^S,iw)*wpar(iw) + end do + case('divide') + if(verbose)write(*,*)'Give dividing factors for each variable:' + read(unitpar,*) wpar(1:nw) + do iw=1,nw + w(ixM^S,iw)=w(ixM^S,iw)/wpar(iw) + end do + case('conserv','conserve') + call conserve(ixM^L,w) + case('primitive') + call primitive(ixM^L,w) + case('uniform') + if(verbose)write(*,*)'Give values for each variable:' + read(unitpar,*) wpar(1:nw) + do iw=1,nw + w(ixM^S,iw)=wpar(iw) + end do + case('shocktube') + call ini_shocktube(ixM^L,w) + case('wave') + call ini_wave(ixM^L,w) + case('wave1') + call wave1(ixM^L,w) + case('special') + call specialini(ixM^L,w) + case('eqpar') + if(verbose)write(*,*)'Equation params:',neqpar+nspecialpar + read(unitpar,*)(eqpar(ieqpar),ieqpar=1,neqpar+nspecialpar) + case('gencoord') + if(verbose)write(*,*)'Generalized coordinates (T/F):' + read(unitpar,*)gencoord + case default + call die('Error in VACIni: no such action') + end select +end do + +{^IFMPI +close(unitpar) +call mpifinalize +} + +end + +!============================================================================= +subroutine ini_grid(coord,ix^L) + +! Setup a uniform grid. When coord is .true., the user provides the coordinates +! for the centers of the grid, otherwise the boundaries of the computational +! domaines, thus the centers start at xmin+dx/2, and end at xmax-dx/2 + +use constants + use common_variables + +logical:: coord +integer:: ix^L,ix^D,idim +double precision:: dx^D,xmax(ndim),xmin(ndim) +!----------------------------------------------------------------------------- + +if(verbose)write(*,'(a,3i6)')'Size of mesh. Max: ',ixGhi^D +read(unitpar,*) nx^D +if(verbose)write(*,'(a,3i6)')'Size of mesh: ',nx^D +if(coord)then + if(verbose)write(*,*)'Coordinates of cell centers at the edges' +else + if(verbose)write(*,*)'Boundaries of the computational domain' +endif +if(verbose)write(*,*)'xmin coordinates:' +read(unitpar,*)(xmin(idim),idim=1,ndim) +if(verbose)write(*,*)'xmax coordinates:' +read(unitpar,*)(xmax(idim),idim=1,ndim) + +! Calculate cell sizes and modify coordinates for 'domain' action +if(coord)then + dx^D=(xmax(^D)-xmin(^D))/(nx^D-1); +else + dx^D=(xmax(^D)-xmin(^D))/nx^D; + {^DLOOP + xmax(^D)=xmax(^D)-dx^D/2 + xmin(^D)=xmin(^D)+dx^D/2 + } +endif + +{^IFMPI +! Distribute global grid onto processor cube +nxall^D=nx^D; +call mpigridsetup +} + +ixmax^D=ixmin^D+nx^D-1; +if(ixmax^D>ixGhi^D|.or.) call die('Error in IniGrid: Too big grid') + +{^IFMPI +! Set coordinate limits for this PE +{^DLOOP +xmin(^D) = xmin(^D) + dx^D*(ixPEmin^D-1) +xmax(^D) = xmin(^D) + dx^D*(nx^D-1) +\} +} + +{forall(ix^DD=ixmin^DD:ixmax^DD) x(ix^DD,^D)= & + ((ix^D-ixmin^D)*xmax(^D)+ & + (ixmax^D-ix^D)*xmin(^D)) /(ixmax^D-ixmin^D) \} + +return +end + +!============================================================================= +{^NOONED +subroutine makepolargrid(ix^L) + +use constants + use common_variables + +integer:: ix^L +double precision:: pi2 +!----------------------------------------------------------------------------- + +if(verbose)write(*,*)& + 'First coordinate is interpreted as radius, second as angle/2pi.' + +pi2=8*atan(one) + +tmp(ix^S)=x(ix^S,1) +x(ix^S,1)=tmp(ix^S)*cos(x(ix^S,2)*pi2) +x(ix^S,2)=tmp(ix^S)*sin(x(ix^S,2)*pi2) + +return +end +} +!============================================================================= +{^IFTHREED +subroutine spheregrid(ix^L) + +use constants + use common_variables + +integer:: ix^L +double precision:: pi2 +!----------------------------------------------------------------------------- + +if(verbose)write(*,*)'R, PHI/2Pi [0,1], THETA/2Pi [-0.25,0.25] --> X,Y,Z' + +pi2=8*atan(one) + +tmp(ix^S)=x(ix^S,1) +x(ix^S,1)=tmp(ix^S)*cos(x(ix^S,3)*pi2)*cos(x(ix^S,2)*pi2) +x(ix^S,2)=tmp(ix^S)*cos(x(ix^S,3)*pi2)*sin(x(ix^S,2)*pi2) +x(ix^S,3)=tmp(ix^S)*sin(x(ix^S,3)*pi2) + +return +end +} +!============================================================================= +{^NOONED +subroutine roundgrid(ix^L) + +! Calculate the shrink factor to shrink a rectangle to an ellipse. For a sguare +! 1 in directions parallel to x and y +! 1-r+r*sqrt(0.5) in diagonal directions, where r is the radial distance +! normalized to 1. + +use constants + use common_variables + +integer:: ix^L +double precision:: dist1(ixG^T),dist2(ixG^T),weight(ixG^T) +double precision:: xcent^D,rounded,squared +!----------------------------------------------------------------------------- + +if(verbose)write(*,*)'Coordinates of center point:' +read(unitpar,*) xcent^D +if(verbose)then + write(*,*)'Center of rounded grid:',xcent^D + write(*,*)'If the rectangle is mapped to the (-1,-1,1,1) square' + write(*,*)'give the distances to be rounded, and to be squared:' +endif +read(unitpar,*)rounded,squared + +! Normalized distances in the L1 and L2 norms + +dist1(ix^S)=max(^D&abs((x(ix^S,^D)-xcent^D)/(x(ixmax^DD,^D)-xcent^D))) +dist2(ix^S)=sqrt(^D&((x(ix^S,^D)-xcent^D)/(x(ixmax^DD,^D)-xcent^D))**2+) + +! The weight increases from 0 to 1 for distance between 0 and rounded, and +! it drops back to 0 in the distance range rounded and squared. +where(dist1(ix^S)nw.or.iw2<1.or.iw2>nw)call die( & + 'Error in RotateVar: Incorrect iw1 and iw2') + +w1(ix^S)=w(ix^S,iw1) +w2(ix^S)=w(ix^S,iw2) +w(ix^S,iw1)=cos(angle)*w1(ix^S)-sin(angle)*w2(ix^S) +w(ix^S,iw2)=sin(angle)*w1(ix^S)+cos(angle)*w2(ix^S) + +return +end + +{^IFTWOD +!============================================================================= +subroutine transposexy(ix^L,w) + +! Transpose the first two coordinates of the grid (x), the variables (w), +! and exchange the vector components as required + +use constants + use common_variables + +integer:: ix^L,ixold^L,ix^D,iw,ivect,idim,qnvector +double precision:: w(ixG^T,1:nw) +!----------------------------------------------------------------------------- +ixold^L=ix^L; +ix^LIM1=ixold^LIM2; +ix^LIM2=ixold^LIM1; +! Transpose x +do idim=1,ndim + !!!For sake of f90tof77 x(ix^S,idim)=transpose(x(ixold^S,idim)) is replaced: + tmp(ix^S)=x(ix^S,idim) + {do ix^D=ixmin^D,ixmax^D\} + x(ix^D,idim)=tmp(ix^DB) + {enddo^D&\} +enddo + +! Swap the X and Y coordinates +tmp(ix^S)=x(ix^S,1) +x(ix^S,1)=x(ix^S,2) +x(ix^S,2)=tmp(ix^S) + +! Transpose w +do iw=1,nw + !!!For sake of f90tof77 w(ix^S,iw)=transpose(w(ixold^S,iw)) is replaced by + tmp(ix^S)=w(ix^S,iw) + {do ix^D=ixmin^D,ixmax^D\} + w(ix^D,iw)=tmp(ix^DB) + {enddo^D&\} +enddo + +! Swap the vector variables +! qnvector is only used to avoid compiler warning when nvector=0 +qnvector=nvector +do ivect=1,qnvector + if(verbose)write(*,"(a,i1,a)")& + 'Index of first component of vector variable #',ivect,':' + read(unitpar,*)iw + if(iw>=nw.or.iw<1)call die('Error in TransposeXY: Incorrect iw.') + tmp(ix^S)=w(ix^S,iw) + w(ix^S,iw)=w(ix^S,iw+1) + w(ix^S,iw+1)=tmp(ix^S) +end do + +return +end +} +!============================================================================= +subroutine regrid(ix^L,w) + +! Change the number of grid points and extrapolate and interpolate the +! original cell positions x and averaged values w. + +use constants + use common_variables + +integer:: ix^L,nix^D,ixnew^L,iw,idim +double precision:: w(ixG^T,1:nw),q(ixG^T) +!----------------------------------------------------------------------------- + +if(verbose)write(*,*)'Define number of gridpoints in each direction:' +read(unitpar,*) nix^D + +ixnewmin^D=ixmin^D; +ixnewmax^D=ixmin^D+nix^D-1; + +do idim=1,ndim + q(ix^S)=x(ix^S,idim) + call regrid1(ix^L,ixnew^L,q) + x(ixnew^S,idim)=q(ixnew^S) +enddo +do iw=1,nw + q(ix^S)=w(ix^S,iw) + call regrid1(ix^L,ixnew^L,q) + w(ixnew^S,iw)=q(ixnew^S) +enddo + +ixmax^D=ixnewmax^D; + +return +end + +!============================================================================= +subroutine regrid1(ixI^L,ixO^L,q) + +! Interpolate q from grid determined by ixI to ixO. Use the distances measured +! between the Cartesian gridpoints, i.e. distances in generalized coordinates. +! The DOMAIN ixImin-0.5..ixImax+0.5 is rediscretized by ixOmax-ixOmin+1 points. + +use constants + use common_variables + +integer:: ixI^L,ixO^L,ixI^D,ixO^D,dixI^D +double precision:: q(ixG^T),qnew(ixG^T),dxO^D,xO^D,coeff^D(0:1) +!----------------------------------------------------------------------------- + +! Grid spacing of the output grid stretched onto the integer input grid +dxO^D=(ixImax^D-ixImin^D+one)/(ixOmax^D-ixOmin^D+one); + +qnew(ixO^S)=zero +{do ixO^D=ixOmin^D,ixOmax^D\} + + ! Location of the output grid point + xO^D=ixImin^D-half+(ixO^D-ixOmin^D+half)*dxO^D; + + ! Index of the input grid point to the left of xO within ixImin..ixImax-1 + ixI^D=min(ixImax^D-1,max(ixImin^D,int(xO^D))); + + ! Calculate bilinear interpolation/extrapolation coefficients + coeff^D(1)=xO^D-ixI^D; + coeff^D(0)=1-coeff^D(1); + + ! Interpolate q into qnew + {do dixI^D=0,1\} + qnew(ixO^D)=qnew(ixO^D)+(coeff^D(dixI^D)*)*q(ixI^D+dixI^D) + {enddo^D&\} + +{enddo^D&\} + +q(ixO^S)=qnew(ixO^S); + +return +end + +!============================================================================= +subroutine stretchgrid(qdomain,ix^L) + +! Stretch the grid logarithmically in direction idim segment by segment +! The original computational domain size is preserved if qdomain is true, +! and the first and last grid center locations are preserved if it is false. + +use constants + use common_variables + +logical:: qdomain +integer:: ix^L,ix,ixL,ixR,idim,iseg,nseg +integer,parameter:: qixhi=10000 +double precision:: qxL,qxR,qdxL,qdxR,qdxsum,qdx(qixhi) +!----------------------------------------------------------------------------- + +if(verbose)write(*,*)'Direction of stretch and number of segments' +read(unitpar,*)idim,nseg + +if(idim>ndim.or.idim<1)call die('Error in StretchGrid: Invalid direction') +if(nseg<1)call die('Error in StretchGrid: Invalid number of segments') + +if(qdomain)then + qxL=1.5*x(ixmin^D,idim)-0.5*x(ixmin^D+1,idim) + qxR=1.5*x(ixmax^D,idim)-0.5*x(ixmax^D-1,idim) + if(verbose)write(*,*)'Old domain from',qxL,' to',qxR +else + qxL=x(ixmin^D,idim) + qxR=x(ixmax^D,idim) + if(verbose)write(*,*)'Old centers from',qxL,' to',qxR +endif + +if(qxL>=qxR)& + call die('Error in StretchGrid: qxRqixhi)call die( & + 'Error in StretchGrid: Too big grid, change qixhi') + ixL=ixmin^D+1 + qdxL=one + qdx(ixL)=qdxL + if(qdomain)then + qdxsum=1.5D0 + else + qdxsum=1.0D0 + endif + do iseg=1,nseg + if(verbose)write(*,*)'xlast-xprev for segment:',iseg + read(unitpar,*)qdxR + if(iseg=ixmax^D) & + call die('Error in StretchGrid: bad segment position') + else + if(verbose)write(*,*)'Last segment ends at right boundary' + ixR=ixmax^D + end if + do ix=ixL+1,ixR + qdx(ix)=qdxL*(qdxR/qdxL)**(dble(ix-ixL)/dble(ixR-ixL)) + qdxsum=qdxsum+qdx(ix) + enddo + qdxL=qdxR + ixL=ixR + end do + if(qdomain)qdxsum=qdxsum+half*qdx(ixR) + qdx(ixmin^D+1:ixmax^D)=qdx(ixmin^D+1:ixmax^D)*(qxR-qxL)/qdxsum + if(qdomain)x(ixmin^D^D%ix^S,idim)=qxL+half*qdx(ixmin^D+1) + do ix=ixmin^D+1,ixmax^D + x(ix^D%ix^S,idim)=x(ix-1^D%ix^S,idim)+qdx(ix) + enddo + \} +end select + +if(qdomain)then + qxL=1.5*x(ixmin^D,idim)-0.5*x(ixmin^D+1,idim) + qxR=1.5*x(ixmax^D,idim)-0.5*x(ixmax^D-1,idim) + if(verbose)write(*,*)'New domain from',qxL,' to',qxR +else + qxL=x(ixmin^D,idim) + qxR=x(ixmax^D,idim) + if(verbose)write(*,*)'New centers from',qxL,' to',qxR +endif + +return +end + +!============================================================================= +subroutine perturbvar(ix^L,w) + +! Perturb a variable within limits ixP by adding the product of sine waves +! in each direction. The phases of the waves are relative to ixPmin. + +use constants + use common_variables + +integer:: ix^L,ixP^L,idim,iw +double precision:: w(ixG^T,nw),dw,wavenum(ndim),phase(ndim) +!----------------------------------------------------------------------------- + +if(verbose)write(*,*)'Variable index, amplitude and',& + ' ixP^DL ' +read(unitpar,*)iw,dw,ixP^DL +{^IFMPI +call mpiixlimits(ixP^L)} +if(verbose)write(*,*)'wavenumber and phase for each idim:' +read(unitpar,*)(wavenum(idim),phase(idim),idim=1,ndim) + +w(ixP^S,iw)=w(ixP^S,iw)+dw* & + {sin(phase(^D)+(x(ixP^S,^D)-x(ixPmin^DD,^D))*wavenum(^D))*} + +return +end + +!============================================================================= +subroutine ini_shocktube(ix^L,w) + +! The shocktube is divided into nseg segments in the chosen idim direction. +! Linear interpolation in segments with given left and right states. + +use constants + use common_variables + +integer:: ix^L +double precision:: w(ixG^T,nw) +integer:: ix,ixL,ixR,idim,iw,iseg,nseg,ieqpar +double precision:: wL(nw),wR(nw) +{^IFMPI logical:: inside} +!----------------------------------------------------------------------------- + +if(verbose)write(*,*)'Normal of slab symmetry' +read(unitpar,*)idim +if(verbose)write(*,*)'Number of segments' +read(unitpar,*)nseg +if(verbose)write(*,*)'All variables at minimal position:' +read(unitpar,*)wL(1:nw) +select case(idim) + {case(^D) + ixL=ixmin^D + {ixL=ixL-ixPEmin^D+1 ^IFMPI} + do iseg=1,nseg + if(verbose)write(*,*)'All variables at end of segment:',iseg + read(unitpar,*)wR(1:nw) + if(iseg=ixmin^D.and.ix<=ixmax^D) & + w(ix^D%ix^S,iw)=((ixR-ix)*wL(iw)+(ix-ixL)*wR(iw))/(ixR-ixL) + + !w(ix^D%ix^S,iw)=((x(ixR^D%ix^S,^D)-x(ix^D%ix^S,^D))*wL(iw)+ & + ! (x(ix^D%ix^S,^D)-x(ixL^D%ix^S,^D))*wR(iw))& + ! /(x(ixR^D%ix^S,^D)-x(ixL^D%ix^S,^D)) + end do + end do + ixL=ixR + wL(1:nw)=wR(1:nw) + end do \} + case default + call die('Error in Ini_ShockTube: Unknown dimension') +end select + +if(verbose)write(*,*)'Eqpar:' +read(unitpar,*)(eqpar(ieqpar),ieqpar=1,neqpar+nspecialpar) + +return +end + +!============================================================================= +subroutine ini_wave(ix^L,w) + +! Sum of sine waves in each direction and each variable + +use constants + use common_variables + +integer:: ix^L,ix^D,idim,iw,ieqpar +double precision:: w(ixG^T,nw),wmean(nw),wavenum(ndim),ampl(ndim),phase(ndim) +logical:: nextiw +!----------------------------------------------------------------------------- + +if(verbose)write(*,*)'Mean values:' +read(unitpar,*)wmean(1:nw) +do iw=1,nw + w(ix^S,iw)=wmean(iw) +end do +do iw=1,nw + if(verbose)write(*,*)'Variable iw:',iw + do + if(verbose)write(*,*)'Amplitude,wavenum,phase for each dim,nextiw=T/F:' + read(unitpar,*)(ampl(idim),wavenum(idim),phase(idim),idim=1,ndim),nextiw + do idim=1,ndim + w(ix^S,iw)=w(ix^S,iw)+ampl(idim)*sin(phase(idim)+& + x(ix^S,idim)*wavenum(idim)) + enddo + if(nextiw)exit + enddo +enddo + +if(verbose)write(*,*)'Eqpar:' +read(unitpar,*)(eqpar(ieqpar),ieqpar=1,neqpar+nspecialpar) + +return +end + +!============================================================================= +subroutine wave1(ix^L,w) + +! Sine waves with arbitrary wave vectors and shifts using rationalized angle +! units (1.0 = full circle) + +use constants + use common_variables + +integer:: ix^L,idim,iw +double precision:: w(ixG^T,nw),wmean,ampl,wavenum(ndim),phase,pi2 +logical:: lastiw +!----------------------------------------------------------------------------- + +pi2=8*atan(one) +if(verbose)& + write(*,*)'w(iw)=wmean+dw*sin(2*pi*[x*kx+y*ky+phase]) (Note the 2*pi!)' +do + if(verbose)write(*,*)'Give iw,wmean,dw,k(idim),phase,lastiw (quit with T):' + read(unitpar,*)iw,wmean,ampl,(wavenum(idim),idim=1,ndim),phase,lastiw + w(ix^S,iw)=wmean+ampl*sin(pi2*({wavenum(^D)*x(ix^S,^D)+}+phase)) + if(lastiw)exit +enddo + +return +end +!============================================================================= +! Some interface routines for subroutines often used in the VACUSR module +! to keep the compiler happy +!============================================================================= +subroutine gradient(realgrad,q,ix^L,idir,gradq) +logical:: realgrad +integer:: ix^L,idir +double precision:: q(*),gradq(*) +call die('Error: VACINI cannot call gradient !') +end + +!============================================================================= +subroutine laplace4(q,ix^L,laplaceq) +integer:: ix^L +double precision:: q(*),laplaceq(*) +call die('Error: VACINI cannot call laplace4 !') +end + +!============================================================================= +subroutine ensurebound(dix,ixI^L,ixO^L,qt,w) +integer:: dix,ixI^L,ixO^L +double precision:: qt,w(*) +call die('Error: VACINI cannot call ensurebound !') +end +!============================================================================= +! end module vacini +!############################################################################## + + diff --git a/sac/vacini b/sac/vacini new file mode 120000 index 0000000..681bea7 --- /dev/null +++ b/sac/vacini @@ -0,0 +1 @@ +src/vacini \ No newline at end of file From db7db937ffffd85131b0f77bc44cc542e05345e3 Mon Sep 17 00:00:00 2001 From: Stuart Mumford Date: Thu, 13 Nov 2014 15:43:36 +0000 Subject: [PATCH 32/32] Update submodule url --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index 39fc107..07b018c 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,3 @@ [submodule "sac/src/fgdfio"] path = sac/src/fgdfio - url = https://github.com/SWAT-Sheffield/fgdfio.git + url = git://github.com/SWAT-Sheffield/fgdfio.git