Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

two subroutines

Status
Not open for further replies.

alleyor

Programmer
Aug 2, 2009
13
CN
There is an old program. In addition to subroutine “storr” and subroutine “scribe”, others can be compilered and obtain accurate results . Please help me revise these two subroutines, thank you !

I'm using IVF9 for windows.

The source code and the input file see Annex.
 
What do you want to revise the subroutines to do?
 
They can't be compilered in ivf9 because of some syntaxs,thank you!
 
Needs a module called global. Look for a file containing

module global

That has to be compiled first. It will probably have something like
Code:
module global
   integer kb(1000)
   integer ab(1000)
   integer a(1000)
end module global

scribe.f
Line 23&30 change to IF (.NOT.ALIVE) GOTO 990
Line 97 put a comma before I2

If you can, next time, put the files as a zip: not a rar. XP and Vista can handle zips. Most people do not have winrar.
 
Module global is included in the "FFFF.f" .Thank you for your recommendation.

MODULE GLOBAL
CHARACTER(10) NIND,NIN,NAT,NBT,NCT,NDT,N5T,
1 NFT,NGT,NHT,NIT,NJT,NKT,NLT,ITITLE,DISCPT
REAL NEM,NET,NEMH,NETH,MU,MUM
REAL*8 MATL
INTEGER H,HH,POROUS,PRESS,RINTER,SOLID,SPALL
INTEGER*8 NN
C MISCELLANEOUS
COMMON AZERO(1),CEF,CKS,DAVG,DELTIM,DISCPT(10),DOLD,DRHO,DTMAX,
1 DTMIN,DTN,DTNH,DU,DX,EOLD,F,FAC,FIRST,J,JCYCS,JINIT,
2 JFIN,JREZON(15),JSMAX,JSTAR,JTS,LSUB(30),M,MAXPR(30),N,NCYCS,
3 NEDIT,NPERN,NR,NREZON,NSCRB(6),NSEPRAT,NSPALL,NTEDT,
4 NTEX,NTR(15),POLD,P6(20),R(30),RLAST,SLAST,SMAX,TEDIT(50),
5 TF,TIME,TJ,TREZON,TS,T6(20),ULAST,UOLD,UZERO,XLAST,XNOW,XOLD
1 ,XJDIT(20)
C HALFSTEP VALUES
COMMON DH,DHLAST,DUH,EH,PH,RH,RHLAST,SH,SHLAST,UH,UHLAST,XH,XHLAST
1 ,NEMH,NETH
C CONDITION INDICATORS
COMMON INF,LINTER,MIRROR,NORMAL,POROUS,PRESS,RINTER,SOLID,SPALL
C CELL LAYOUT
COMMON DXX(30),JBND(30),JMAT(30),NAUTO,MATL(6,2),NLAYER,NMTRLS,
1 THK(30)
C
C NAMED COMMON
COMMON /EQS/ EQSTA(6),EQSTC(6),EQSTD(6),EQSTE(6),EQSTG(6),
1 EQSTH(6),EQSTN(6),EQSTS(6),EQSTV(6),CZQ(6),CWQ(6),C2(6)
COMMON /MELT/ EMELT(6,8),GMELT(6,8),SPH(6),THERM(6,8)
COMMON /RHO/ RHO(6),RHOS(6)
COMMON /TSR/ TSR(6,30),EXMAT(6,20),TENS(6,3)
COMMON /Y/ Y0(6),YADD(6),MU(6),MUM,YADDM
C COORDINATE ARRAYS
COMMON/COORD/X(200),X0(200),CHL(2400),DHL(200),DPDD(200),DPDE(200)
1 ,EHL(200),H(200,4),NEM(200),NET(200),PHL(200),RHL(200),SDT(200),
2 SHL(200),T(200),U(200),YHL(200),ZHL(200)
COMMON/NSC/A(5000)
DIMENSION KB(300)
COMMON /JED/JEDIT(100),JNUM(100),JTYP(100),NAME2(40),JEDSIZ,
1 MODLUS,NERR,NJEDIT,NTAPE
COMMON /IND/ IEOS(6),INDK(20),NALPHA,NCMP(6),NFR(6),NPOR(6),
1 NDS(6),NPR(6),NCON(6),NVAR(6)
COMMON /RAD/ SSTOP(9),START(9),SDURM,SSTOPM,NSPEC,SSJ,JSS,IPLOT(4)
1 ,XMAX(4),XMIN(4),YMAX(4),YMIN(4),IA(7),ITITLE(24),NARZ,TARZ
COMMON /PES/ LVMAX,LVTOT,LVAR(4200),COM(4000)
C
COMMON /ESC/ ESC(8,20)
DIMENSION DELFIN(30,5),DELX(30,5),TH(30,5),NCELLS(30,5),NZONES(30)
EQUIVALENCE (DELFIN,H(1)),(DELX,H(151)),(TH,H(301)),
1 (NCELLS,H(451)),(NZONES,H(601))
EQUIVALENCE (A(2501),KB)
DIMENSION NN(20),NAME(40),LA(200)
EQUIVALENCE (LA,A)
DATA (NAME(I),I=1,33)/3HX ,3HX0 ,3HC ,3HD ,4HDPDD,4HDPDE,3HE ,
1 3HH1 ,3HH2 ,3HH3 ,3HNEM,3HNET,3HP ,3HR ,3HSDT,3HS1 ,3HT ,3HU
2 ,3HY ,3HZ ,4HCOM1,4HCOM2,4HCOM3,4HCOM4,4HCOM5,'SINT',3HS2 ,
3 3HS3 ,3HIMP,3HV ,3HSD1,3HSD2,3HSD3/
DATA (NAME2(I),I=1,33)/1HX,2HX0,1HC,1HD,4HDPDD,4HDPDE,1HE,2HH1,
1 2HH2,2HH3,3HNEM,3HNET,1HP,1HR,3HSDT,2HS1,1HT,1HU,
2 1HY,1HZ,4HCOM1,4HCOM2,4HCOM3,4HCOM4,4HCOM5,'SINT',2HS2,2HS3,
3 3HIMP,1HV,3HSD1,3HSD2,3HSD3/
END MODULE

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top