!> iondump-para.F !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> ION_OPEN_WRITE_HDF !! !! Open an HDF file for reading data !! function ION_OPEN_READ_HDF(basename, suffix_1, suffix_2, $ mjd, iStep,time_of_step) ! ... Local variables .................................................. integer ion_open_read_hdf, ion2d_take_var, iontake_close logical first, GRID character*80 fname character*80 dumpfile character*2048 namer_in character*256 run_ident,input_file logical SAMEOLD, SAMERUN #ifdef BCAST #include "mpif.h" #endif #include "hdf.inc" #include "global_dims.inc" #include "help.inc" #include "param.inc" #include "run-time.inc" #include "dipole.inc" #include "runattr.inc" dimension x2((ni_global+1),(nj_global+1)), $ y2((ni_global+1),(nj_global+1)),phi(nk_global+1) #ifdef ION_ON dimension x2ion(nj+1,nk/2+3),y2ion(nj+1,nk/2+3) dimension xinterp(mion_i,mion_j),yinterp(mion_i,mion_j) #endif integer*4 iMJDId integer*4, save :: iFileId integer*4 iSecId,iSecIndex, iaDimId, iAttrId, iRank integer iNtype, iNAttr integer sfstart, sfend, sfscatt, sfcreate, sfwcdata integer sfwdata, sfendacc,sffattr,sfrnatt,sfrcatt integer sfn2index,sfginfo,sfrdata,sfselect integer sfsattr, sfrattr integer iLen, iStatus integer iFileStart, iFileStop, iFileInterval integer iaDim4d(4), iaStart4d(4), iaEdge4d(4),iaStride4d(4) integer iaDim3d(3), iaStart3d(3), iaEdge3d(3),iaStride3d(3) integer iaDim2d(2), iaStart2d(2), iaEdge2d(2),iaStride2d(2) integer iaDim1d(1), iaStart1d(1), iaEdge1d(1),iaStride1d(1) character*80 caCont, caDim, caSec, caAttr, dipole character*20 caTmp logical InFile c real*8 ttime, time_of_step real*4 ttime4 character *(40) VARNAME * dimension dumvar(nsize_i*nsize_j*nsize_k) dimension dumvar2(nsize_i,nsize_j) ! ... Parameter variables .............................................. character *128 basename, suffix_1, suffix_2 real*8 mjd ! ... Begin ............................................................ #ifdef DEBUG_MODE_ON write(*,*) "DEBUG: in iontake-para.F::ion_open_read_hdf(...)" #endif c c check to see if this is the I/O processor c if ( mype .ne. 0 ) return c c >jgl test write (9,1913) mype 1913 format ('In iontake_first ',i3) c !open and setup hdf file c ilen = index(basename,char(0))-1 if (mjd < 0) then write(input_file, 976) basename(1:ilen), suffix_1(1:7), $ suffix_2(1:3) ilen = ilen + 16 else write(input_file, 976) basename(1:ilen), suffix_1(1:20), $ suffix_2(1:3) ilen = ilen + 29 endif 976 format(A, '_ion_', A, '.', A) write(*,977) input_file(1:ilen) 977 format("Reading, '", A, "'") iFileId = sfstart(input_file(1:ilen),DFACC_RDONLY) if (iFileId .lt. 0 ) then write(*,*) 'Unable to open',input_file,'for read!' ! write(6,979) input_file(1:ilen) ! 979 format('Unable to open ',A,' for read!') call MPI_ABORT(MPI_COMM_WORLD,MPI_ERR_OTHER) endif if ( mjd > 0 ) then iMJDId = sffattr(iFileId,'mjd') iStatus = sfrcatt(iFileId,iMJDId,mjd) endif !determine who wrote the file iSecId = sffattr(iFileId,'run_descriptor') iStatus = sfrcatt(iFileId,iSecId,run_ident) #ifdef DEBUG_MODE_ON write (6,*) run_ident #endif SAMEOLD = SAMERUN(run_label,run_ident) if ( .not. SAMEOLD ) then write (6,*) 'not a consistent set of files' call MPI_ABORT(MPI_COMM_WORLD,MPI_ERR_OTHER) endif iSecId = sffattr(iFileId,'written_by') iStatus = sfrcatt(iFileId,iSecId,caAttr) if (iStatus .eq. -1) $ call MPI_ABORT(MPI_COMM_WORLD,MPI_ERR_OTHER) if (caAttr(1:1) .eq. 'C') then write(6,*) 'Unable to restart from C files' call MPI_ABORT(MPI_COMM_WORLD,MPI_ERR_OTHER) endif c return c c * !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> read in variables !! Entry ION2D_TAKE_VAR(varname, dumvar2,nsize_i,nsize_j, $ iiStep,ttime) ! ! ... Entry ............................................................. ! c check for I/O processor c if ( mype .ne. 0 ) return c c c >jgl test write (9,1916) mype,varname 1916 format ('In ion2d_take_var ',i3, a40) ! Read in variable for timestep len = index(VARNAME,char(0))-1 call rststr(caSec) caSec(1:len) = VARNAME(1:len) iSecIndex = sfn2index(iFileId,caSec) iSecId = sfselect(iFileId, iSecIndex) iAttrId = sffattr(iSecId,'time_step') iStatus = sfrnatt(iSecId,iAttrId,jStep) if (iStatus .eq. -1) $ call MPI_ABORT(MPI_COMM_WORLD,MPI_ERR_OTHER) !! check for old style 'time' attribute if sffattr fails iAttrId = sffattr(iSecId,'time_8byte') if ( iAttrId .eq. -1 ) then iAttrId = sffattr(iSecId,'time') iStatus = sfrnatt(iSecId,iAttrId,ttime4) ttime = ttime4 else iStatus = sfrnatt(iSecId,iAttrId,ttime) endif if (iStatus .eq. -1) $ call MPI_ABORT(MPI_COMM_WORLD,MPI_ERR_OTHER) #ifdef DEBUG_MODE_ON write(6,*) 'IONTAKE: ',jStep,ttime #endif iStatus = sfginfo(iSecId,caSec,iRank,iaDim2d,iNtype,iNAttr) if (iStatus .eq. -1) $ call MPI_ABORT(MPI_COMM_WORLD,MPI_ERR_OTHER) iAttrId = sffattr(iSecId,'ni') iStatus = sfrnatt(iSecId,iAttrId,iNi) iAttrId = sffattr(iSecId,'nj') iStatus = sfrnatt(iSecId,iAttrId,iNj) if ( (iaDim2d(1) .ne. nsize_i) .or. $ (iaDim2d(2) .ne. nsize_j) ) then write (6,*) 'dimensions in hdf file inconsistent with ', $ 'code dims' write (6,*) 'index code file' write(6,*) '1 ',nsize_i,iaDim2d(1) write(6,*) '2 ',nsize_j,iaDim2d(2) call MPI_ABORT(MPI_COMM_WORLD,MPI_ERR_OTHER) endif iaStride2d(1) = 1 iaStart2d(1) = 0 iaEdge2d(1) = iNi iaStride2d(2) = 1 iaStart2d(2) = 0 iaEdge2d(2) = iNj iStatus = $ sfrdata(iSecId,iaStart2d,iaStride2d,iaEdge2d,dumvar2) if (iStatus .eq. -1) $ call MPI_ABORT(MPI_COMM_WORLD,MPI_ERR_OTHER) iStatus = sfendacc(iSecId) if (iStatus .eq. -1) $ call MPI_ABORT(MPI_COMM_WORLD,MPI_ERR_OTHER) #ifdef DEBUG_MODE_ON write(6,*) 'Done with HDFTAKE' #endif ! ION2D_TAKE_VAR = iStep ION2D_TAKE_VAR = iStatus return c entry iontake_close !close file on last dump c c check to see if this is the I/O processor c if ( mype .ne. 0 ) return c iStatus = sfend(iFileId) iontake_close = iStatus #ifdef DEBUG_MODE_ON write (9,1910) mype 1910 format ('In hdfdump_first ',i3) return #endif !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! ... End function ION_OPEN_WRITE_HDF ................................... end !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!