×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Please

Please

(OP)
Help me! please!
I'm writing a scientific program for my thesis. I'm getting the error message: severe <161>: Program Exception - array bounds exceeded:

Quote (Program Principle2
DOUBLE PRECISION ABSORPC,ABSORPF,BT2,BT21,CPAIR,CPC,CPF,DEBA,DH
DOUBLE PRECISION DT,DUREET,EMITC,EMITF,EPS,FCF,FCSKY,FGC,HCCA
DOUBLE PRECISION HCFA,HIGHC,HIGHD,HRCF,HRCSKY,HRGC,HW,LAMDAAIR
DOUBLE PRECISION LAMDAC,LAMDAF,LARGEC,LARGED,LARGEF,LONGD,LONGF
DOUBLE PRECISION ITER,MA,MC,MF,MUAIR,NUAF,NUAIR,PRAIR,PST,QVAIR
DOUBLE PRECISION RED,RHOAIR,RHOC,RHOF,SC,SCT,SECT,SF,SFBMC,ST
DOUBLE PRECISION TAMBID,TAUC,TNC,TNF,TSKY,UAIR,UAIR2,UB,VA,VC,VF
DOUBLE PRECISION TA1(70),TA2(70),TC1(70),TC2(70)
DOUBLE PRECISION TF1(70),TF2(70),HR(70),PS(70),PU(70)
DIMENSION FLGUL(12,24),FLGULA(12,24),HUR(12,24),TAMB(12,24)
DIMENSION RDTT(24),PUT(24)
INTEGER IH,J,IT,ITMAX,JN,KH1,KH2,KL,KM,LN,PH
OPEN(5,FILE='PU_TA.DAT',STATUS='OLD')
OPEN(6,FILE='TC_TF.DAT',STATUS='OLD')
OPEN(7,FILE='TF_TC.DAT',STATUS='OLD')
OPEN(8,FILE='TA_HR.DAT',STATUS='OLD')
OPEN(9,FILE='PS_PU.DAT',STATUS='OLD')
OPEN(10,FILE='KM_IH_TC.DAT',STATUS='OLD')
OPEN(11,FILE='KM_IH_TF.DAT',STATUS='OLD')
OPEN(12,FILE='KM_IH_TA.DAT',STATUS='OLD')
OPEN(13,FILE='KM_IH_TAMB.DAT',STATUS='OLD')
OPEN(14,FILE='KM_IH_HR.DAT',STATUS='OLD')
OPEN(15,FILE='KM_IH_PU.DAT',STATUS='OLD')
OPEN(16,FILE='KM_IH_FLGUL.DAT',STATUS='OLD')
OPEN(17,FILE='IH_HR.DAT',STATUS='OLD')
OPEN(18,FILE='KM_IH_RDTT.DAT',STATUS='OLD')
OPEN(25,FILE='Flux_TAMB.DAT',STATUS='OLD')
ITMAX=100.D0
CALL solar(FLGUL,HUR,TAMB,KH1,KH2,PH)
CALL propertiesofdryer(LONGD,LARGED,HIGHD,DT,EPS,ST
$,TNC,LARGEC,HIGHC,SC,MC,CPC,TAUC,ABSORPC,LAMDAC
$,VC,RHOC,LONGF,LARGEF,SF,MF,CPF,ABSORPF,LAMDAF,TNF
$,VF,RHOF,UB,SCT,JN,LN)
CALL airindryer(MA,CPAIR,RHOAIR,LAMDAAIR,UAIR,QVAIR
$,MUAIR,PRAIR,VA,LONGD,LARGED,HIGHD,DEBA,NUAIR,SECT)
CALL initialdryer1(TC1,TF1,TA1,TAMBID
$,TC2,TF2,TA2,J,JN)
!380 CONTINUE
ITER=3600.D0/DT
!10 DO 50 KM=1,4
DO 50 KM=1,12
! DO 40 IH=KH1,KH2,PH
DO 40 IH=1,24,PH
PUT(IH)=0.D0
FLGULA(KM,IH)=FLGUL(KM,IH)*LONGD/(LAMDAC*TAMB(KM,IH))
IT=0.
DUREET=0.D0
DO 30 KL=1,ITER
!Before loop initialdryer
20 CONTINUE
BT2=0.
BT21=0.
CALL dryer(ABSORPC,ABSORPF,CPAIR,CPC,CPF,DH,DT,DEBA
$,EMITC,EMITF,EPS,FCF,FCSKY,FGC,FLGUL,HCCA,HCFA,HRCF,BT2
$,HRGC,HRCSKY,HW,IH,IT,ITMAX,J,JN,LAMDAAIR,MA,MC,MF
$,MUAIR,NUAF,PRAIR,PU,RED,RHOAIR,SC,SF,SFBMC,ST,TA1,TA2
$,TAMB,PST,TAMBID,TAUC,TC1,TC2,TF1,TF2,TSKY,UAIR,UAIR2
$,DUREET,KM)
IT=IT+1
print *,'IT=',IT
read(*,*)
IF(IT.LT.ITMAX) THEN
GOTO 20
ELSE
STOP
END IF
BT21=BT21+(BT2*DT)
print *,'BT21=',BT21
read(*,*)
30 CONTINUE
PUT(IH)=BT21
CALL TEC(PUT,SCT,FLGUL,RDTT,IH,KM)
CALL Resprin(TC2,TF2,TA2,TAMB,HR,IH,JN
$,FLGUL,RDTT,PS,PU,KM,J)
40 CONTINUE
WRITE(25,*) IH,FLGUL(KM,IH),TAMB(KM,IH)
50 CONTINUE
CALL Resprin(TC2,TF2,TA2,TAMB,HR,IH,JN
$,FLGUL,RDTT,PS,PU,KM,J)
CLOSE(5)
CLOSE(6)
CLOSE(7)
CLOSE(8)
CLOSE(9)
CLOSE(10)
CLOSE(11)
CLOSE(12)
CLOSE(13)
CLOSE(14)
CLOSE(15)
CLOSE(16)
CLOSE(17)
CLOSE(18)
CLOSE(25)
END Program Principle2
!******************************************************************************
!****************** Subroutine Principle_Weather ******************************
SUBROUTINE solar(FFLGUL,HHUR,TTAMB,KKH1,KKH2,PPH)
REAL LONG
INTEGER PPH,LH
DOUBLE PRECISION HL1,HC1
DIMENSION RGM(12),DJ(12),RDIFH(12,24),TTAMB(12,24),RGH(12,24)
DIMENSION FFLGUL(12,24),HHUR(12,24),RDIRH(12,24)
DO 60 M=1,12
CALL METEO(M,D,NJA,RGM,TTAMB,HHUR)
CALL SIT(DR,SP,CP,TP,SB,CB,CAZ,SAZ,PHI,LONG,BETA
$,ALB,NF,KKH1,KKH2,PPH,AZ)
CALL ENSOL(BETA,PHI,DR,SP,CP,TP,SB,CB,CAZ,SAZ
$,RGM,RDIFH,RGH,FFLGUL,DJ,LONG,NJA,NF,KKH1,KKH2,PPH
$,LH1,LH2,MM,DD,RDIRH,HL1,HC1)
60 CONTINUE
CALL RES_METEO(M,KKH1,KKH2,DJ,FFLGUL)
STOP
END SUBROUTINE solar
!****************** Subroetine solar radiation ********************************
SUBROUTINE ENSOL(BBETA,PPHI,DDR,SSP,CCP,TTP,SSB,CCB,CCAZ
$,SSAZ,RRGM,RRDIFH,RRGH,FFFLGUL,DDJ,LLONG,NNJA,NNF,KKKH1
$,KKKH2,PPPH,LLH1,LLH2,MM,DD,RRDIRH,HHL1,HHC1)
DIMENSION RRGM(12),RRDIFH(12,24),RRGH(12,24)
DIMENSION DDJ(12),RRDIRH(12,24),FFFLGUL(12,24)
DOUBLE PRECISION HHL1,HHC1
REAL INC,NH,LLONG,KH
INTEGER PPPH
PI=DDR*180.
DELTA=23.45*SIN(360.*(284.+NNJA)/365.*DDR)
SD=SIN(DELTA*DDR)
CD=COS(DELTA*DDR)
TD=TAN(DELTA*DDR)
OM=2.*DDR*180./366.
WJ=OM*NNJA
ET=0.002+7.3509*SIN(WJ)-0.4197*COS(WJ)+9.3912*SIN(2.*WJ)
$+3.2265*COS(2.*WJ)+0.3361*SIN(3.*WJ)+0.0903*COS(3.*WJ)
AHS=ACOS(-TD*TTP)
HL1=12.*(1.-AHS/PI)
HC1=12.*(1.+AHS/PI)
LLH1=INT(HL1)
LLH2=INT(HC1)
KKKH1=LLH1-1
KKKH2=LLH2+2
DDJ(MM)=24.*AHS/PI
DO 380 KH=KKKH1,KKKH2,PPPH
TSV=KH-NNF+ET/60.+LLONG/15.
AH=(TSV-12.)*PI/12.
CC=1.+0.034*COS((30.*(MM-1)+DD)*DDR)
CAH=COS(AH)
SAH=SIN(AH)
CHH=COS(AHS)
SHH=SIN(AHS)
CAB=COS((PPHI-BBETA)*DDR)
SAB=SIN((PPHI-BBETA)*DDR)
SINH=SSP*SD+CCP*CD*CAH
IF(SINH.LE.0.) GO TO 1
COSINC=CCB*SINH+SSAZ*SSB*CD*SAH+CCAZ*SSB*CD*SSP*(CAH-TD/TTP)
IF(COSINC.GT.1.)COSINC=0.
IF(COSINC.LT.0.)COSINC=0.
INC=ACOS(COSINC)/DDR
HS=ASIN(SINH)
XA1=CD*SAH/COS(HS)
AZ=ASIN(XA1)
HAUTS=HS/DDR
ANGL=AH/DDR
XW1=CD**(SHH-AHS*CHH)
PGLOH=24.*3600.*1353./PI*CC*XW1
XKT=RRGM(MM)/PGLOH
IF((TSV.GE.HHC1).OR.(TSV.LE.HHL1))THEN
RPT=0.
RDH=0.
RDC=0.
ELSE
AA=0.4090+.5016*SIN(AHS-PI/3.)
BB=0.6609-0.4767*SIN(AHS-PI/3.)
AX1=SHH-AHS*CHH
RPT=PI/24*(AA+BB*CAH)*(CAH-CHH)/AX1
RDH=PI/24.*(CAH-CHH)/AX1
RGD=-1.9843*XKT*XKT+0.2154*XKT+0.9881D0
FLDIFG=RGD*RRGM(MM)
RRGH(MM,KH)=RPT*RRGM(MM)
RRDIFH(MM,KH)=RDH*FLDIFG
ENDIF
FFFLGUL(MM,KH)=RRGH(MM,KH)+RRDIFH(MM,KH)
RRDIRH(MM,KH)=FFFLGUL(MM,KH)-RRDIFH(MM,KH)
GO TO 380
1 INC=0.
380 CONTINUE
RETURN
END SUBROUTINE ENSOL
!****************** Subroutine Position of dryer ******************************
SUBROUTINE SIT(DDR,SSP,CCP,TTP,SSB,CCB,CCAZ,SSAZ,PPHI
$,LLONG,BBETA,AALB,NNF,KKKH1,KKKH2,PPPH,AAZ)
INTEGER PPPH
REAL LLONG
OPEN(1,FILE='Data_Lieu.for',STATUS='OLD')
READ(1,*)AAZ,BBETA
READ(1,*)PPHI,LLONG,AALB
READ(1,*)KKKH1,KKKH2,PPPH
READ(1,*)NNF
CLOSE(1)
DDR=ATAN(1.)/45.
SSP=SIN(PPHI*DDR)
CCP=COS(PPHI*DDR)
TTP=TAN(PPHI*DDR)
SSB=SIN(BBETA*DDR)
CCB=COS(BBETA*DDR)
SSAZ=SIN(AAZ*DDR)
CCAZ=COS(AAZ*DDR)
RETURN
END SUBROUTINE SIT
!****************** Subroutine meteo in month *********************************
SUBROUTINE METEO(MM,DD,NNJA,RRGM,TTTAMB,HHHUR)
DIMENSION RRGM(12),TTTAMB(12,24),HHHUR(12,24)
OPEN (2,FILE='Data_Moyen.for',STATUS='OLD')
DO 80 MM=1,12
READ(2,*)RRGM(MM)
80 CONTINUE
CLOSE(2)
IF (MM.EQ.1) THEN
DD=17
NNJA=17
OPEN (3,FILE='Data_Jan05.for',STATUS='OLD')
ELSE
ENDIF
IF (MM.EQ.2) THEN
DD=16
NNJA=47
OPEN (3,FILE='Data_Feb05.for',STATUS='OLD')
ELSE
ENDIF
IF (MM.EQ.3) THEN
DD=16
NNJA=75
OPEN (3,FILE='Data_Mar05.for',STATUS='OLD')
ELSE
ENDIF
IF (MM.EQ.4) THEN
DD=15
NNJA=105
OPEN (3,FILE='Data_Avr05.for',STATUS='OLD')
ELSE
ENDIF
IF (MM.EQ.5) THEN
DD=15
NNJA=135
OPEN (3,FILE='Data_Mai05.for',STATUS='OLD')
ELSE
ENDIF
IF (MM.EQ.6) THEN
DD=11
NNJA=162
OPEN (3,FILE='Data_Jun05.for',STATUS='OLD')
ELSE
ENDIF
IF (MM.EQ.7) THEN
DD=17
NNJA=198
OPEN (3,FILE='Data_Jul05.for',STATUS='OLD')
ELSE
ENDIF
IF (MM.EQ.8) THEN
DD=16
NNJA=228
OPEN (3,FILE='Data_Aou05.for',STATUS='OLD')
ELSE
ENDIF
IF (MM.EQ.9) THEN
DD=15
NNJA=258
OPEN (3,FILE='Data_Sep05.for',STATUS='OLD')
ELSE
ENDIF
IF (MM.EQ.10) THEN
DD=10
NNJA=288
OPEN (3,FILE='Data_Oct05.for',STATUS='OLD')
ELSE
ENDIF
IF (MM.EQ.11) THEN
DD=11
NNJA=318
OPEN (3,FILE='Data_Nov05.for',STATUS='OLD')
ELSE
ENDIF
IF (MM.EQ.12) THEN
DD=12
NNJA=344
OPEN (3,FILE='Data_Dec05.for',STATUS='OLD')
END IF
DO 90 KKKH=1,24
90 READ(3,*)TTTAMB(MM,KKKH),HHHUR(MM,KKKH)
DO 100 KKKH=1,24
100 TTTAMB(MM,KKKH)=TTTAMB(MM,KKKH)+273.15
RETURN
END SUBROUTINE METEO
!***************** Subroutine of result weather *******************************
SUBROUTINE RES_METEO(MM,KKKH1,KKKH2,DDJ,FFFLGUL)
DIMENSION FFFLGUL(12,24),DDJ(12)
OPEN(4,FILE='RESULT_METEO',STATUS='OLD')
WRITE(4,170)
WRITE(4,180)DDJ(MM)
DO 110 MM=1,12
WRITE(4,160)MM
110 CONTINUE
WRITE(4,150)
DO 120 MM=1,12
WRITE(4,160)MM
WRITE(4,100)(FFFLGUL(MM,KJ),KJ=KKKH1,KKKH2)
120 CONTINUE
DO 130 MM=1,12
WRITE(4,160)MM
130 CONTINUE
DO 140 MM=1,12
WRITE(4,160)MM
140 CONTINUE
100 FORMAT(2X,6(E8.3,2X),/2X,6(E8.3,2X),/2X,6(E8.3,2X),/2X,6(E8.3,2X))
150 FORMAT(2X,'Densité de flux horaire sur une plaque horizontale')
160 FORMAT(2X,'Numero du mois', 2X, I3)
170 FORMAT(2X,'Durée du jour')
180 FORMAT(3X,6(F10.2,2X)/,3X,6(F10.2,2X))
CLOSE(4)
RETURN
END SUBROUTINE RES_METEO
!******************************************************************************
!****************** End sub-Program weather ***********************************
!******************************************************************************
!****************** Subroutine Principle_Properties of dryer ******************
!******************************************************************************
SUBROUTINE propertiesofdryer(LLONGD,LLARGED,HHIGHD,DDT,EEPS,SST
$,TTNC,LLARGEC,HHIGHC,SSC,MMC,CCPC,TTAUC,AABSORPC,LLAMDAC
$,VVC,RRHOC,LLONGF,LLARGEF,SSF,MMF,CCPF,AABSORPF,LLAMDAF,TTNF
$,VVF,RRHOF,UUB,SSCT,JJN,LLN)
DOUBLE PRECISION LLONGD,LLARGED,HHIGHD,DDT,EEPS,SST,TTNC
DOUBLE PRECISION LLARGEC,HHIGHC,SSC,MMC,CCPC,TTAUC,AABSORPC
DOUBLE PRECISION LLAMDAC,VVC,RRHOC,LLONGF,LLARGEF,SSF,MMF,CCPF
DOUBLE PRECISION AABSORPF,LLAMDAF,TTNF,VVF,RRHOF,UUB,SSCT
INTEGER JJN,LLN
REAL PI
!Properties of dryer
LLONGD=12.4D0
LLARGED=9.D0
HHIGHD=3.35D0
DDT=600.D0
EEPS=1.D-3
SST=LLARGED*HHIGHD
JJN=13
LLN=3
!Properties of cover
LLONGC=12.4D0
LLARGEC=9.D0
HHIGHC=3.35D0
TTNC=6.D-3
PI=3.14159265D0
SSC=PI*(HHIGHC**2)/2.
SSCT=PI*HHIGHC*LLONGC
VVC=SSC*TTNC
RRHOC=1200.D0
MMC=RRHOC*VVC
CCPC=1.17D3
TTAUC=0.9D0
AABSORPC=0.1D0
LLAMDAC=0.21D0
!Properties of concrete
LLONGF=12.4D0
LLARGEF=9.D0
TTNF=0.15D0
SSF=LLARGEF*LLONGF
VVF=SSF*TTNF
RRHOF=7900.D0
MMF=RRHOF*VVF
AABSORPF=0.95D0
CCPF=450.D0
LLAMDAF=26.D0
UUB=LLAMDAF/TTNF
END SUBROUTINE propertiesofdryer
!****************** Subroutine Air inside dryer *******************************
SUBROUTINE airindryer(MMA,CCPAIR,RRHOAIR,LLAMDAAIR,UUAIR,QQVAIR
$,MMUAIR,PPRAIR,VVA,LLONGD,LLARGED,HHIGHD,DDEBA,NNUAIR,SSECT)
DOUBLE PRECISION MMA,CCPAIR,RRHOAIR,LLAMDAAIR,UUAIR,MMUAIR,PPRAIR
DOUBLE PRECISION VVA,LLONGD,LLARGED,HHIGHD,DDEBA,NNUAIR,SSECT
DOUBLE PRECISION QQVAIR
REAL PI
PI=3.14159265D0
LLONGD=12.4D0
LLARGED=9.D0
HHIGHD=3.35D0
CCPAIR=1005.D0
LLAMDAAIR=0.02624D0
MMUAIR=1.918D-5
PPRAIR=0.707D0
RRHOAIR=1.177D0
UUAIR=SSECT*QQVAIR
SSECT=(PI*HHIGHD**2)/2.D0
VVA=LLONGD*SSECT
MMA=RRHOAIR*LLONGD*SSECT
DDEBA=(RRHOAIR*SSECT*UUAIR)/2.
NNUAIR=MMUAIR/RRHOAIR
END SUBROUTINE airindryer
!****************** Subroutine Principle_Initial temperature data dryer *******
SUBROUTINE initialdryer1(TTC1,TTF1,TTA1,TTAMBID
$,TTC2,TTF2,TTA2,JJ,JJN)
DOUBLE PRECISION TTC1(70),TTF1(70),TTA1(70),TTAMBID
DOUBLE PRECISION TTC2(70),TTF2(70),TTA2(70)
INTEGER JJN,JJ
DO 250 JJ=1,JJN
TTAMBID=303.15D0
TTC1(JJ)=TTAMBID
TTF1(JJ)=TTAMBID
TTA1(JJ)=TTAMBID
TTC2(JJ)=TTAMBID
TTF2(JJ)=TTAMBID
TTA2(JJ)=TTAMBID
250 CONTINUE
END SUBROUTINE initialdryer1
!******************************************************************************
!****************** End input data ********************************************
!******************************************************************************
!****************** Subroutine Principle_Dryer ********************************
SUBROUTINE dryer(AABSORPC,AABSORPF,CCPAIR,CCPC,CCPF,DDH,DDT,DDEBA
$,EEMITC,EEMITF,EEPS,FFCF,FFCSKY,FFGC,FFLGUL,HHCCA,HHCFA,HHRCF,BBT2
$,HHRGC,HHRCSKY,HHW,IIH,IIT,IITMAX,JJ,JJN,LLAMDAAIR,MMA,MMC,MMF
$,MMUAIR,NNUAF,PPRAIR,PPU,RRED,RRHOAIR,SSC,SSF,SSFBMC,SST,TTA1,TTA2
$,TTAMB,PPST,TTAMBID,TTAUC,TTC1,TTC2,TTF1,TTF2,TTSKY,UUAIR,UUAIR2
$,DDUREET,KKM)
DOUBLE PRECISION AABSORPC,AABSORPF,CCPAIR,CCPC,CCPF,DDH
DOUBLE PRECISION EEMITC,EEMITF,EEPS,FFCF,FFCSKY,FFGC
DOUBLE PRECISION HHRCF,HHRCSKY,HHRGC,HHW,LLAMDAAIR,MMA,MMC
DOUBLE PRECISION HHCFA,MMF,MMUAIR,NNUAF,PPRAIR,PPU(70),RRED
DOUBLE PRECISION SSF,SSFBMC,SST,TTA1(70),TTA2(70),TTAMBID
DOUBLE PRECISION TTAUC,TTC1(70),TTC2(70),TTF1(70),TTF2(70)
DOUBLE PRECISION TTSKY,UUAIR,UUAIR2,RRHOAIR,SSC,DDUREET,PPST
DOUBLE PRECISION DDT,DDEBA,HHCCA,BBT2
DIMENSION TTAMB(12,24),FFLGUL(12,24)
INTEGER JJN,JJ,K,IIH,KKM,LLN
REAL A(70,70),Y(70),X(70)
! OPEN(5,FILE='DATA_DRYER.DAT',STATUS='NEW')
!Time duration
ITMAX=100.
380 CONTINUE
DO 280 JJ=1,JJN
IT=0
270 CONTINUE
TAVC=TTC2(JJ)
TAVF=TTF2(JJ)
print *,'TAVC=',TAVC
print *,'TAVF=',TAVF
! read(*,*)
CALL coheat(JJ,HHW,HHCCA,HHRCSKY,HHCFA,HHRCF,HHRGC
$,LLAMDAAIR,TTC2,TTF2,TTSKY,TTAMB,DDH,RRHOAIR,EEMITC
$,EEMITF,SSC,SSF,MMUAIR,PPRAIR,NNUAF,RRED,UUAIR,UUAIR2
$,FFCSKY,FFCF,FFGC,SSFBMC,KKM,IIH)
CALL cotemp(LLN,JJ,HHW,HHCCA,HHRCSKY,HHCFA,HHRCF
$,HHRGC,FFLGUL,CCPC,SSC,MMC,TTAUC,AABSORPC,TTC1,MMA
$,TTA1,TTA2,SSF,MMF,CCPF,AABSORPF,TTF1,TTSKY,TTAMB
$,CCPAIR,DDT,SST,A,Y,KKM,IIH,I,L)
CALL Gauss(3,A,Y,X)
TTC2(JJ)=X(1)
PPU(JJ)=X(2)
TTF2(JJ)=X(3)
ERTC=ABS(TAVC-TTC2(JJ))
ERTF=ABS(TAVF-TTF2(JJ))
print *,'ERTC=',ERTC
print *,'ERTF=',ERTF
! read(*,*)
IF ((ERTC.GE.EEPS).OR.(ERTF.GE.EEPS)) THEN
IT=IT+1
print *,'IT=',IIT
IF (IT.LT.ITMAX) GOTO 270
END IF
! print *,'TC2(J)before=',TC2(J)
! print *,'PU(J)before=',PU(J)
! print *,'TF2(J)before=',TF2(J)
PPST=PPU(JJ)*SST
TTA2(JJ+1)=(PPU(JJ)/(DDEBA*CCPAIR))+TTA2(JJ)
BBT2=BBT2+PPST
print *,'BT2=',BBT2
print *,'PU=',PPU(JJ)
print *,'TC2=',TTC2(JJ)
print *,'TF2=',TTF2(JJ)
print *,'TA2=',TTA2(JJ)
print *,'TA2(J+1)=',TTA2(JJ+1)
print *,'J=',JJ
! read (*,*)
280 CONTINUE
IF (K.LE.JJN) THEN
DO 390 K=1,JJN
TTC1(K)=TTC2(K)
TTA1(K)=TTA2(K)
TTF1(K)=TTF2(K)
390 CONTINUE
ELSE
END IF
CALL resultdryer(PPU,TTC2,TTA2,TTF2,DDUREET)
DDUREET=DDUREET+DDT
print *,'DUREE',DDUREET
! read(*,*)
END SUBROUTINE dryer
!****************** Subroutine Coefficient of heat transfer *******************
SUBROUTINE coheat(JJJ,HHHW,HHHCCA,HHHRCSKY,HHHCFA,HHHRCF,HHHRGC
$,LLLAMDAAIR,TTTC2,TTTF2,TTTSKY,TTTAMB,DDDH,RRRHOAIR,EEEMITC
$,EEEMITF,SSSC,SSSF,MMMUAIR,PPPRAIR,NNNUAF,RRRED,UUUAIR,UUUAIR2
$,FFFCSKY,FFFCF,FFFGC,SSSFBMC,KKKM,IIIH)
DOUBLE PRECISION HHHW,HHHCCA,HHHRCSKY,HHHCFA,HHHRCF,HHHRGC
DOUBLE PRECISION LLLAMDAAIR,TTTC2(70),TTTF2(70),TTTSKY
DOUBLE PRECISION RRRHOAIR,EEEMITC,EEEMITF,SSSC,SSSF,MMMUAIR
DOUBLE PRECISION RRRED,UUUAIR,PPPRAIR,UUUAIR2,FFFCSKY,FFFCF
DOUBLE PRECISION DDDH,SSSFBMC,NNNUAF,FFFGC
DIMENSION TTTAMB(12,24)
INTEGER JJJ,IIIH,KKKM
DDDH=25.D0
EEEMITC=9.4D-1
EEEMITF=8.5D-1
SSSFBMC=5.670373D-8
UUUAIR2=5.D-1
RRRED=(RRRHOAIR*UUUAIR*DDDH)/MMMUAIR
NNNUAF=0.023D0*(RRRED**0.8D0)*(PPPRAIR**0.33D0)
TTTSKY=0.0552D0*(TTTAMB(KKKM,IIIH)**1.5D0)
FFFCSKY=(1.D0+(SSSC/SSSF))/2.D0
FFFCF=1.D0-FFFCSKY
FFFGC=1.D0
HHHRCSKY=(SSSFBMC*(((TTTC2(JJJ)**2)+TTTSKY**2))
$*(TTTC2(JJJ)+TTTSKY))/(((1-EEEMITC)/EEEMITC)+(1/FFFCSKY))
HHHRCF=(SSSFBMC*(((TTTC2(JJJ)**2)+TTTF2(JJJ)**2))*(TTTC2(JJJ)
$+TTTF2(JJJ)))/(((1-EEEMITC)/EEEMITC)+(1/FFFCF))
HHHRGC=(SSSFBMC*(((TTTC2(JJJ)**2)+TTTF2(JJJ)**2))*(TTTC2(JJJ)
$+TTTF2(JJJ)))/((1/EEEMITC)-(1/FFFGC)+(1/EEEMITF))
HHHW=10.03D0+(4.687D0*UUUAIR2)
HHHCCA=4.3D0*(TTTC2(JJJ)**0.25D0)
HHHCFA=(NNNUAF*LLLAMDAAIR)/DDDH
print *,'TSKY=',TTTSKY
print *,'FCSKY=',FFFCSKY
print *,'FCF=',FFFCF
print *,'FGC=',FFFGC
print *,'HRCSKY=',HHHRCSKY
print *,'HRCF=',HHHRCF
print *,'HRGC=',HHHRGC
print *,'HW=',HHHW
print *,'HCCA=',HHHCCA
print *,'HCFA=',HHHCFA
! read(*,*)
END SUBROUTINE coheat
!Check Subroutine TEMPERATURE
SUBROUTINE cotemp(LLLN,JJJ,HHHW,HHHCCA,HHHRCSKY,HHHCFA,HHHRCF
$,HHHRGC,FFFLGUL,CCCPC,SSSC,MMMC,TTTAUC,AAABSORPC,TTTC1,MMMA
$,TTTA1,TTTA2,SSSF,MMMF,CCCPF,AAABSORPF,TTTF1,TTTSKY,TTTAMB
$,CCCPAIR,DDDT,SSST,AA,YY,KKKM,IIIH,II,LL)
DOUBLE PRECISION HHHW,HHHCCA,HHHRCSKY,HHHCFA,HHHRCF,HHHRGC
DOUBLE PRECISION CCCPC,SSSC,MMMC,TTTAUC,AAABSORPC
DOUBLE PRECISION MMMA,CCCPAIR,TTTA1(70),TTTA2(70),TTTC1(70)
DOUBLE PRECISION SSSF,MMMF,CCCPF,AAABSORPF,TTTF1(70)
DOUBLE PRECISION TTTSKY,DDDT,SSST
DIMENSION FFFLGUL(12,24),TTTAMB(12,24)
INTEGER II,JJJ,LL,LLLN
REAL AA(70,70),YY(70)
DO 290 LL=1,LLLN
DO 290 II=1,LLLN
AA(II,LL)=0.D0
290 CONTINUE
AA(1,1)=((MMMC*CCCPC)/(SSST*DDDT))+
$(SSSC*HHHCCA/SSST)+
$(SSSC*HHHW/SSST)+
$(SSSC*HHHRCSKY/SSST)+
$(SSSC*HHHRCF/SSST)
print *,'AA(1,1)=',AA(1,1)
AA(1,2)=0
print *,'AA(1,2)=',AA(1,2)
AA(1,3)=-(SSSC*HHHRCF/SSST)
print *,'AA(1,3)=',AA(1,3)
AA(2,1)=-(SSSC*HHHCCA/SSST)
print *,'AA(2,1)=',AA(2,1)
AA(2,2)=1.D0
print *,'AA(2,2)=',AA(2,2)
AA(2,3)=-(SSSF*HHHCFA/SSST)
print *,'AA(2,3)=',AA(2,3)
AA(3,1)=-(SSSF*HHHRGC/SSST)
print *,'AA(3,1)=',AA(3,1)
AA(3,2)=0
print *,'AA(3,2)=',AA(3,2)
AA(3,3)=((MMMF*CCCPF)/(SSST*DDDT))+
$(SSSF*HHHCFA/SSST)+
$(SSSF*HHHRGC/SSST)
print *,'AA(3,3)=',AA(3,3)
!Calculated Y
YY(1)=((MMMC*CCCPC*TTTC1(JJJ))/(SSST*DDDT))+
$(SSSC*HHHCCA/SSST)+
$(SSSC*HHHW*TTTAMB(KKKM,IIIH)/SSST)+
$(SSSC*HHHRCSKY*TTTSKY/SSST)+
$(SSSC*AAABSORPC*FFFLGUL(KKKM,IIIH)/SSST)
print *,'YY(1)=',YY(1)
YY(2)=(MMMA*CCCPAIR*TTTA1(JJJ)/(SSST*DDDT))-
$(MMMA*CCCPAIR*TTTA2(JJJ)/(SSST*DDDT))-
$(SSSC*HHHCCA*TTTA2(JJJ)/SSST)-
$(SSSF*HHHCFA*TTTA2(JJJ)/SSST)
print *,'YY(2)=',YY(2)
YY(3)=((MMMF*CCCPF*TTTF1(JJJ))/(SSST*DDDT))+
$(SSSF*HHHCFA*TTTA2(JJJ)/SSST)+
$(SSSF*TTTAUC*AAABSORPF*FFFLGUL(KKKM,IIIH)/SSST)
print *,'YY(3)=',YY(3)
! read(*,*)
END SUBROUTINE cotemp
!Check Subroutine Gauss-Jordan
SUBROUTINE Gauss(NG,AA,YY,XX)
INTEGER L,NG,M,P,Q,II,S
REAL DP,AA(70,70),YY(70),XX(70),D,SOM
DO 330 L=1,NG-1
DP=1./AA(L,L)
DO 300 M=L,NG
AA(L,M)=AA(L,M)*DP
300 CONTINUE
YY(L)=YY(L)*DP
DO 320 P=L+1,NG
D=AA(P,L)
DO 310 Q=L,NG
AA(P,Q)=AA(P,Q)-D*AA(L,Q)
310 CONTINUE
YY(P)=YY(P)-D*YY(L)
320 CONTINUE
330 CONTINUE
!Result
XX(NG)=YY(NG)/AA(NG,NG)
DO 350 II=1,NG-1
SOM=0
DO 340 S=NG-II+1,NG
SOM=SOM+AA(NG-II,S)*XX(S)
340 CONTINUE
XX(NG-II)=YY(NG-II)-SOM
350 CONTINUE
END SUBROUTINE Gauss
!Check Subroutine Result
SUBROUTINE resultdryer(PPPU,TTTC2,TTTA2,TTTF2,DDDUREET)
DOUBLE PRECISION PPPU(70),TTTC2(70),TTTF2(70)
DOUBLE PRECISION DDDUREET,TTTA2(70)
WRITE(5,*) DDDUREET, PPPU(1), TTTA2(1)
WRITE(6,*) DDDUREET, TTTC2(1), TTTF2(1)
END SUBROUTINE resultdryer
!******************************************************************************
!****************** End calculation of dryer **********************************
!******************************************************************************
!****************** Subroutine Thermal efficiency of the dryer ****************
SUBROUTINE TEC(PPUT,SSCT,FFLGUL,RRDTT,IIH,KKM)
DOUBLE PRECISION SSCT
! DOUBLE PRECISION RRDTT(160)
DIMENSION FFLGUL(12,24),RRDTT(24),PPUT(24)
INTEGER IIH,KKM
!Rendement thermique du séchoir :
RRDTT(IIH)=PPUT(IIH)/(FFLGUL(KKM,IIH)*SSCT*3600.D0)
print *,'SCT=',SSCT
print *,'PUT=',PPUT(IIH)
print *,'RDTT=',RRDTT(IIH)
! read(*,*)
END SUBROUTINE TEC
!******************************************************************************
!****************** End calculation of thermal efficiency *********************
!******************************************************************************
!****************** Subroutine result of principle program ********************
SUBROUTINE Resprin(TTC2,TTF2,TTA2,TTAMB,HHR,IIH,JJN
$,FFLGUL,RRDTT,PPS,PPU,KKM,JJ)
DOUBLE PRECISION TTC2(70),TTF2(70)
DOUBLE PRECISION TTA2(70),HHR(70)
DOUBLE PRECISION PPS(70),PPU(70)
DIMENSION FFLGUL(12,24),TTAMB(12,24),RRDTT(24)
INTEGER IIH,JJ,JJN,KKM
print *,'JN=',JJN
print *,'IH=',IIH
! read(*,*)
WRITE(7,*) IIH
WRITE(8,*) IIH
WRITE(9,*) IIH
DO 360 JJ=1,JJN
WRITE(7,*) TTF2(JJ),TTC2(JJ)
WRITE(8,*) TTA2(JJ),HHR(JJ)
WRITE(9,*) PPS(JJ),PPU(JJ)
360 CONTINUE
WRITE(10,*) KKM,IIH,TTC2(JJ)
WRITE(11,*) KKM,IIH,TTF2(JJ)
WRITE(12,*) KKM,IIH,TTA2(JJ)
WRITE(13,*) KKM,IIH,TTAMB(KKM,IIH)
WRITE(14,*) KKM,IIH,HHR(JJ)
WRITE(15,*) KKM,IIH,PPU(JJ)
WRITE(16,*) KKM,IIH,FFLGUL(KKM,IIH)
WRITE(17,*) IIH
DO 370 JJ=1,JJN
WRITE(17,*) HHR(JJ)
370 CONTINUE
WRITE(18,*) KKM,IIH,RRDTT(IIH)
END SUBROUTINE Resprin)

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login


Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close