#if defined(IBM) || defined(AIX) #define LNBLNK_OR_LEN_TRIM len_trim #elif defined(T3E) #define LNBLNK_OR_LEN_TRIM trimlen #else #define LNBLNK_OR_LEN_TRIM lnblnk #endif !> iondump-para.F !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> ION_OPEN_WRITE_HDF !! !! Open an HDF file for writting data !! integer function ION_OPEN_WRITE_HDF(base,suffix_1, suffix_2, $ mjd, llstep,time_of_step) implicit none ! ... Local variables .................................................. integer ion2d_dump_var character*80 fname,dumpfile #include "hdf.inc" #include "global_dims.inc" integer NI,NJ,NK,no,li,lj,lk integer llow, lihigh, ljhigh integer num_procs, num_mhd, num_ion #include "help.inc" #include "param.inc" #include "run-time.inc" #include "dipole.inc" #include "runattr.inc" ! revision.inc is generated by build process ! should contain the following: ! CHARACTER*(*) REPO_REV ! PARAMETER(REPO_REV=REPOSITORY_VERSION) #include "revision.inc" character*256 revision_str integer blnk_len real x2ion(nj+1,nk/2+3),y2ion(nj+1,nk/2+3) real xinterp(mion_i,mion_j),yinterp(mion_i,mion_j) integer ni_globalp1,nj_globalp1,nk_globalp1,llstep integer iondump_close real*8 time_of_step, ttime, tttime real*4 ttime_4 integer*4, save :: iFileId integer*4 iSecId, iaDimId, iRank, iStatus integer sfstart, sfend, sfscatt, sfcreate, sfwcdata integer sfwdata, sfendacc, sfsnatt integer sfsattr, sfrattr integer iLen,len,nsize_i,nsize_j,LNBLNK_OR_LEN_TRIM 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) integer iVal character*80 caCont, caDim, caSec, caAttr character*20 caTmp character*120 output_file character *(40) VARNAME, units character*(40) Varname_list(100) c c 64 bit intel machine using the Intel FORTRAN compilers segfaults with: c dimension dumvar2(nsize_i,nsize_j) c ... so, use the f90 equivalent instead: real, dimension (nsize_i, nsize_j) :: dumvar2 ! ... Parameter variables .............................................. character*128 base,suffix_1, suffix_2 real*8 mjd ! ... Begin ............................................................ #ifdef DEBUG_MODE_ON write(*,*) "DEBUG: in iondump-para.F::ION_OPEN_WRITE_HDF(...)" #endif c c check to see if this is the I/O processor c if ( mype .ne. 0 ) return c ilen = index(base,char(0))-1 if (mjd < 0) then write(output_file, 976) base(1:ilen), suffix_1(1:7), $ suffix_2(1:3) else write(output_file, 976) base(1:ilen), suffix_1(1:20), $ suffix_2(1:3) endif 976 format(A, '_ion_', A, '.', A) ilen = blnk_len(output_file,120) ! write(*,977) output_file(1:ilen) ! 977 format("Writting, '", A, "'") iFileId = sfstart(output_file(1:ilen),DFACC_CREATE) #ifdef DEBUG_MODE_ON write(6,*) 'iondump: ION HDF File opened for timestep ', $ itimestep #endif ni_globalp1 = ni_global + 1 nj_globalp1 = nj_global + 1 nk_globalp1 = nk_global + 1 ! Content description write(caCont, 900) Ni_global,Nj_global,Nk_global, No 900 format('Ionosphere for 3D-MHD ',i3,' ',i3,' ',i3,' ',i3) c ! Run Descriptor iLen=index(run_label,'##')+1 #ifdef DEBUG_MODE_ON write(6,*) ' Writing run descriptor' #endif c iStatus = sfscatt(iFileId,'run_descriptor',DFNT_CHAR8, iStatus = sfsattr(iFileId,'run_descriptor',DFNT_CHAR8, + iLen,run_label) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! * Use properties (svn:keywords) to add revision meta data to HDF file. * http://svnbook.red-bean.com/en/1.1/ch07s02.html * * Subversion defines five variables: * - Date * - Revision * - Author * - HeadURL * - Id (a combination of the above) * * These will auto-updated when the property is set for a source file: * * svn propset svn:keywords "Id" [filename] * * For now, we use the Id... * * Where's $GlobalRev$? * http://svnbook.red-bean.com/en/1.4/svn.advanced.props.special.keywords.html * * Set Global Revision via method described here: * http://subversion.tigris.org/faq.html#version-value-in-source * * See also * - MIX/src/IO.C * - LFM-para/src/hdfdump-para.F * - LFM-para/src/iondump-para.F * revision_str = |"$Id: iondump-para.F 1651 2011-05-20 18:05:14Z schmitt $\0" iLen=LNBLNK_OR_LEN_TRIM(revision_str) #ifdef DEBUG_MODE_ON write(6,*) ' Writing I/O Revision string >',revision_str(1:iLen) #endif iStatus = sfscatt(iFileId,'I/O Revision',DFNT_CHAR8, $ iLen,revision_str) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! revision_str = ! | REPOSITORY_REVISION_NUMBER ! ^^^^^^^^^^_^^^^^^^^_^^^^^^ (preprocessor flag from Makefile) iLen=LNBLNK_OR_LEN_TRIM(REPO_REV) #ifdef DEBUG_MODE_ON write(6,*) ' Writing Repository Revision string >', $ revision_str(1:iLen) #endif iStatus = sfscatt(iFileId,'Repository Revision',DFNT_CHAR8, $ iLen,REPO_REV) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! iLen=LNBLNK_OR_LEN_TRIM(caCont) #ifdef DEBUG_MODE_ON write(6,*) ' Writing file contents' #endif c iStatus = sfscatt(iFileId,'file_contents',DFNT_CHAR8, iStatus = sfsattr(iFileId,'file_contents',DFNT_CHAR8, + iLen,caCont) !Written by #ifdef DEBUG_MODE_ON write(6,*) ' Writing written by' #endif c iStatus = sfscatt(iFileId,'written_by',DFNT_CHAR8, iStatus = sfsattr(iFileId,'written_by',DFNT_CHAR8, + 12,'PARA-FORTRAN') ! ! Dump Modified Julian Date if it's greater than 0... ! if (mjd > 0) then #ifdef DEBUG_MODE_ON write(6,*) ' Writing modified julian date' #endif iStatus = sfscatt(iFileId,'mjd',DFNT_FLOAT64,1,mjd) iStatus = sfsnatt(iFileId,'mjd',DFNT_FLOAT64,1,mjd) endif !Dump Time Step #ifdef DEBUG_MODE_ON write(6,*) ' Writing time step' #endif c iStatus = sfscatt(iFileId,'time_step',DFNT_INT32,1,LSTEP) iStatus = sfsnatt(iFileId,'time_step',DFNT_INT32,1,LSTEP) c !Dump Time #ifdef DEBUG_MODE_ON write(6,*) ' Writing time' #endif ttime = time_of_step iStatus = sfsnatt(iFileId,'time_8byte',DFNT_FLOAT64,1,ttime) ttime_4 = real(ttime,4) iStatus = sfsnatt(iFileId,'time',DFNT_FLOAT32,1,ttime_4) !Run parameters eventually write(caCont,950) 'Not yet used!' 950 format(a) iLen=LNBLNK_OR_LEN_TRIM(caCont) iaStride1d(1)=1 iaStart1d(1)=0 iaEdge1d(1)=iLen iaDim1d(1)=iLen iRank=1 iSecId=sfcreate(iFileId,'run_params',DFNT_CHAR8,iRank,iaDim1d) c iStatus = sfwcdata(iSecId,iaStart1d,iaStride1d,iaEdge1d, iStatus = sfwdata(iSecId,iaStart1d,iaStride1d,iaEdge1d, + caCont) iStatus = sfendacc(iSecId) c c ion_open_write_hdf = iStatus return c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! entry ION2D_DUMP_VAR(VARNAME,dumvar2,nsize_i,nsize_j, $ llstep,tttime) ! ! ... Entry ............................................................. ! ! ionospheric variables added here c c check for I/O processor c if ( mype .ne. 0 ) return c c ! In this format each varible is its own SDS iRank=2 iaStride2d(1)=1 iaStart2d(1)=0 iaStride2d(2)=1 iaStart2d(2)=0 iaEdge2d(1)= nsize_i iaEdge2d(2) = nsize_j iaDim2d(1)=nsize_i iaDim2d(2)=nsize_j len = index(VARNAME,char(0))-1 call rststr(caSec) caSec(1:len) = VARNAME(1:len) iSecId=sfcreate(iFileId,caSec,DFNT_FLOAT32,iRank,iaDim2d) !add time and timestep as attributes c iStatus = sfscatt(iSecId,'time_step',DFNT_INT32,1,llstep) iStatus = sfsattr(iSecId,'time_step',DFNT_INT32,1,llstep) iStatus = sfsattr(iSecId,'time_8byte',DFNT_FLOAT64,1,tttime) ttime_4=real(tttime,4) iStatus = sfsattr(iSecId,'time',DFNT_FLOAT32,1,tttime) c load the array dimensions iStatus = sfsattr(iSecId,'ni',DFNT_INT32,1,nsize_i) iStatus = sfsattr(iSecId,'nj',DFNT_INT32,1,nsize_j) !output the varible data iStatus = sfwdata(iSecId,iaStart2d,iaStride2d,iaEdge2d,dumvar2) iStatus = sfendacc(iSecId) ion2d_dump_var = iStatus return entry iondump_close !close file on last dump c c check to see if this is the I/O processor c c >jgl test write (9,1910) mype 1910 format ('In hdf_close ',i3) if ( mype .ne. 0 ) then iStatus= 0 else iStatus = sfend(iFileId) endif c iondump_close = iStatus return !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! ... End integer function ION_OPEN_WRITE_HDF ........................... end !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!