C INTERNATIONAL AVS CENTER C (This disclaimer must remain at the top of all files) C C WARRANTY DISCLAIMER C C This module and the files associated with it are distributed free of charge. C It is placed in the public domain and permission is granted for anyone to use, C duplicate, modify, and redistribute it unless otherwise noted. Some modules C may be copyrighted. You agree to abide by the conditions also included in C the AVS Licensing Agreement, version 1.0, located in the main module C directory located at the International AVS Center ftp site and to include C the AVS Licensing Agreement when you distribute any files downloaded from C that site. C C The International AVS Center, MCNC, the AVS Consortium and the individual C submitting the module and files associated with said module provide absolutely C NO WARRANTY OF ANY KIND with respect to this software. The entire risk as to C the quality and performance of this software is with the user. IN NO EVENT C WILL The International AVS Center, MCNC, the AVS Consortium and the individual C submitting the module and files associated with said module BE LIABLE TO C ANYONE FOR ANY DAMAGES ARISING FROM THE USE OF THIS SOFTWARE, INCLUDING, C WITHOUT LIMITATION, DAMAGES RESULTING FROM LOST DATA OR LOST PROFITS, OR ANY C SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES. C C This AVS module and associated files are public domain software unless C otherwise noted. Permission is hereby granted to do whatever you like with C it, subject to the conditions that may exist in copyrighted materials. Should C you wish to make a contribution toward the improvement, modification, or C general performance of this module, please send us your comments: why you C liked or disliked it, how you use it, and most important, how it helps your C work. We will receive your comments at avs@ncsc.org. C C Please send AVS module bug reports to avs@ncsc.org. C C Author: "insert name" (if users state on release form that they wish to C remain anonymous, a control number will be placed at this location) C Modifications: Who modified, date modified ( so donor does not receive blame C if modifications made and passed on to others do not work as described) c -this subroutine is here just by way of example, to show c how the dump file is written from the solution phase c of FLOW3D c ---- don't try to link it! c SUBROUTINE IODUMP(VAR,PROP,XNN,CONV,WORK, + IPTVAR,ILVAR,IPTPRO,ILPROP,MWRITE) C C*********************************************************************** C C THIS SUBROUTINE DUMPS GRID AND VARIABLE VALUES TO DISK C C MWRITE = -1 WRITE OUT THE GRID C MWRITE = 1 WRITE OUT THE SOLUTION C C IFRMAT = 0 UNFORMATTED OUTPUT C IFRMAT = N WRITE OUT N SIGNIFICANT FIGURES C C*********************************************************************** C C THIS SUBROUTINE IS CALLED BY THE FOLLOWING SUBROUTINE C FLOW3D C C*********************************************************************** C MODIFIED C 11/12/87 PHA TO ALLOW THE OPTION OF WRITING A FORMATTED FILE C 26/06/89 NSW TO INCLUDE RADIATION C C*********************************************************************** C LOGICAL LTURB,LTEMP,LBUOY,LCOMP,LSCAL + ,LRECT,LCYN,LAXIS,LGRID,LTRANS C COMMON /ALL/ + NI,NIM1,NJ,NJM1,NK,NKM1,NIJ,NIJK COMMON /ADDIMS/ + NIP1,NJP1,NKP1,NINDEX,NIGRID,NJGRID,NKGRID,NDGRID,NVAR,NPROP +,NDVAR,NDPROP,NDXNN,NDGEOM,NDCOEF,NILIST,NRLIST,NIWS,NRWS +,NITURB,NJTURB,NKTURB,NDTURB,NITEMP,NJTEMP,NKTEMP,NDTEMP +,NISCAL,NJSCAL,NKSCAL,NDSCAL,NITRAN,NJTRAN,NKTRAN,NDTRAN COMMON /DEVICE/ + NREAD,NWRITE,NRDISK,NWDISK COMMON /IOFMT/ + IFRMAT COMMON /LOGIC/ + LTURB,LTEMP,LBUOY,LCOMP,LSCAL +,LRECT,LCYN,LAXIS,LGRID,LTRANS COMMON /RADN/ + URFRAD,IRAD,IRADCL COMMON /RADPOI/ + ITEMPS,IHEATF,IFLUX,NFLUX C DIMENSION VAR(NDVAR),PROP(NDPROP),XNN(NDXNN),CONV(NIJK*3) +,WORK(NRWS) +,IPTVAR(NVAR),ILVAR(NVAR),IPTPRO(NPROP),ILPROP(NPROP) C CHARACTER*14 FORMT C C*********************************************************************** C C-----IF FORMATTED I/O GET FORMAT IF(IFRMAT.NE.0) THEN CALL GETFMT(FORMT) ENDIF C C-----WRITE GEOMETRY DATA C IF (MWRITE.LE.0) THEN IF(IFRMAT.EQ.0) THEN WRITE(NWRITE,6600) NWDISK WRITE (NWDISK,ERR=950) NI,NJ,NK, + (XNN(I),I=1,NDXNN) C ELSE WRITE(NWRITE,6800) NWDISK WRITE(NWRITE,6900) FORMT WRITE (NWDISK,5000) NI,NJ,NK WRITE (NWDISK,FMT=FORMT) + (XNN(I),I=1,NDXNN) ENDIF ELSE IF(IFRMAT.EQ.0) THEN WRITE(NWRITE,6700)NWDISK ELSE WRITE(NWRITE,6950)NWDISK ENDIF C C-----WRITE DUMP OF VARIABLE VALUES C DO 10 IVAR = 1, NVAR IF (ILVAR(IVAR).EQ.1) THEN ISTART = IPTVAR(IVAR) ILAST = ISTART + NIJK - 1 IF(IFRMAT.EQ.0) THEN WRITE (NWDISK) (VAR(I),I=ISTART,ILAST) ELSE WRITE (NWDISK,FMT=FORMT) + (UNDRFL(VAR(I)),I=ISTART,ILAST) ENDIF ENDIF 10 CONTINUE C DO 20 IPROP = 1, NPROP IF (ILPROP(IPROP).EQ.1) THEN ISTART = IPTPRO(IPROP) ILAST = ISTART + NIJK - 1 IF(IFRMAT.EQ.0) THEN WRITE (NWDISK) (PROP(I),I=ISTART,ILAST) ELSE WRITE (NWDISK,FMT=FORMT) + (UNDRFL(PROP(I)),I=ISTART,ILAST) ENDIF ENDIF 20 CONTINUE C C-----WRITE DUMP OF CONVECTION COEFFICIENTS. C-----THIS IS NECESSARY FOR CORRECT RESTART OF RHIE-CHOW ALGORITHM. C-----ALSO, THESE MAY BE USEFUL FOR GRAPHICAL PURPOSES, C-----SINCE THEY OBEY EXACT MASS CONTINUITY. C ISTART = 1 ILAST = 3*NIJK IF(IFRMAT.EQ.0) THEN WRITE (NWDISK) (CONV(I),I=ISTART,ILAST) ELSE WRITE (NWDISK,FMT=FORMT) + (UNDRFL(CONV(I)),I=ISTART,ILAST) ENDIF C C-----IF RADIATION INCLUDED, DUMP HEATF AND FLUX C IF (IRAD.GT.0) THEN IS1 = IHEATF IL1 = IHEATF+NIJK-1 IS2 = IFLUX IL2 = IFLUX+NFLUX-1 IF (IFRMAT.EQ.0) THEN WRITE (NWDISK) (WORK(I),I=IS1,IL1),(WORK(I),I=IS2,IL2) ELSE WRITE (NWDISK,FMT=FORMT) + (WORK(I),I=IS1,IL1),(WORK(I),I=IS2,IL2) ENDIF ENDIF C ENDIF RETURN C-----ERROR RETURNS 950 CONTINUE WRITE(NWRITE,*) ' ERROR ENCOUNTERED WRITING DATA TO DISK ' STOP 5000 FORMAT(1X,3I6) 6600 FORMAT(/,' GRID WRITTEN (UNFORMATTED) TO DISK ON UNIT ',I3,/) 6800 FORMAT(/,' GRID WRITTEN ( FORMATTED) TO DISK ON UNIT ',I3,/) 6700 FORMAT(/,' SOLUTION WRITTEN (UNFORMATTED) TO DISK ON UNIT ',I3,/) 6950 FORMAT(/,' SOLUTION WRITTEN ( FORMATTED) TO DISK ON UNIT ',I3,/) 6900 FORMAT(/,' FORMAT IS ',A14,/) END