编译Fortran代码时出现错误和警告？ 这是我照着敲的代码 subroutine hfum (nmati, msin, ninfi, sinfi, nmato, 2 sout, ninfo, sinfo, idsmi, idsii, 3 idsmo, idsio, ntot, nsubs, idxsub, 4 itype, nint, int, nreal, real, 5 ids, npo, nbopst, niwork, iwork, 6 nwork, work, nsize, size, intsiz, 7 ld ) c implicit none #include "ppexec_user.cmn" #include "dms_plex.cmn" real*8 b(1) equivalence (b(1),ib(1)) #include "dms_ncomp.cmn" c c declare arguments c integer nmati, ninfi, nmato, ninfo, ntot, + nsubs, nint, npo, niwork,nwork, + nsize, nreal c integer idsmi(2,nmati), idsii(2,ninfi), + idsmo(2,nmato), idsio(2,ninfo), + idxsub(nsubs),itype(nsubs), int(nint), + ids(2,3), nbopst(6,npo), + iwork(niwork),intsiz(nsize),ld c real*8 msin(ntot,nmati), sinfi(ninfi), + sout(ntot,nmato), sinfo(ninfo), + work(nwork), size(nsize), real(nreal) c c declare local variables c integer offset, ierr, ldata, kdiag, idx(10), ncp, i, j, index + lmw, ntubes, iperm, iret, ifail real*8 diam, len, diff, cg, rej_coef, c1, c2, c3, c4, p_perm, + delta_p, rho, mu, fin, cin, pin, uave, re, sc, + cp, cr, km, jm, fp, pret, xmw, x(10), flow c declare functions integer usrutl_get_real_param, + usrutl_get_int_param, + usrutl_set_real_param integer dms_ifcmnc real*8 dlog c c begin executable code c get configured real variables from aspen plus ifail=0 index=0 ierr=usrutl_get_real_param('diam',index,diam) if (ierr .ne. 0) then write (user_nhstry,*) 'error fetching hydraulic diameter' ifall=1 end if c ierr=usrutl_get_real_param('len',index,len) if (ierr .ne. 0) then write (user_nhstry,*) 'error fetching length' ifall=1 end if c ierr=usrutl_get_real_param('diff',index,diff) if (ierr .ne. 0) then write (user_nhstry,*) 'error fetching duffusivity' ifall=1 end if c ierr=usrutl_get_real_param('gel_conc',index,cg) if (ierr .ne. 0) then write (user_nhstry,*) 'error fetching gel concentration' ifall=1 end if c ierr=usrutl_get_real_param('rej_coef',index,rej_coef) if (ierr .ne. 0) then write (user_nhstry,*) 'error fetching rejection coefficient' ifall=1 end if c ierr=usrutl_get_real_param('coef1',index,c1) if (ierr .ne. 0) then write (user_nhstry,*) 'error fetching coef1' ifall=1 end if c ierr=usrutl_get_real_param('coef2',index,c2) if (ierr .ne. 0) then write (user_nhstry,*) 'error fetching coef2' ifall=1 end if c ierr=usrutl_get_real_param('coef3',index,c3) if (ierr .ne. 0) then write (user_nhstry,*) 'error fetching coef3' ifall=1 end if c ierr=usrutl_get_real_param('coef4',index,c4) if (ierr .ne. 0) then write (user_nhstry,*) 'error fetching coef4' ifall=1 end if c ierr=usrutl_get_real_param('perm_pres',index,p_perm) if (ierr .ne. 0) then write (user_nhstry,*) 'error fetching permeate pressure' ifall=1 end if c ierr=usrutl_get_real_param('celta_p',index,delta_p) if (ierr .ne. 0) then write (user_nhstry,*) 'error fetching pressure drop' ifall=1 end if c get configured integer variables from aspen plus ierr=usrutl_get_int_param('ntubes', index, ntubes) if (ierr .ne. 0) then write (user_nhstry,*) 'error fetching number of tubes' ifall=1 end if c calculate viscosity call shs_cpack(msin(1,1), ncp, idx, x, flow) kdiag=4 call ppmon_viscl(msin(ncomp_ncc+2,1), msin(ncomp_ncc+3,1), x, ncp, + idx, nbopst, kdiag, mu, ierr) if (ierr .ne. 0) then write(user_nhstry, *) ' error evaluating viscosity for feed' ifall=1 end if c if (ifall .eq. 1) return c get location of molecular weight data lmw=dms_ifcmnc('mw') c model equations rho=msin(ncomp_ncc+8,1) / 1000 mu=mu*10 fin=msin(ncomp_ncc+1,1) * msin(ncomp_ncc+9,1) / rho*3600 cin=msin(2,1) * b(lmw+2) / fin *3600000 pin=msin(ncomp_ncc+3,1) / 101325 uave=fin / (diam**2*3.14*ntubes/4) * 1000 / 3600 re=diam * uave * rho / mu sc=mu / (rho * diff) c cp=cg * (1-rej_coef) km=c1 * re**c2 * sc**c3 * (diam/len)**c4 * diff/diam/100 c jm=km * dlog((cg - cp) / (cin - cp)) fp=jm * diam * len * 3.14 * ntubes*100*3600/1000 c cr=(cin - fp/fin*cp) / (1 - fp/fin) c pret=pin-delta_p c assume peameate stream is first,switch if not iperm=1 iret=2 if (idsmo(1,1) .eq. 'rete') then iperm=2 iret=1 end if c fill sout arry for permeate stram sout(1,iperm) = fp * rho / 3600 / b(lmw+1) sout(2,iperm) = fp * cp / 1000 /3600 / b(lmw+2) sout(3,iperm) = sout(1,iperm) + sout(2,iperm) sout(4,iperm) = msin(4,1) sout(5,iperm) = p_perm * 101325 c fill sout array for retentat stream using values from permeate stream sout(1,iret) = msin(1,1) - sout(1,iperm) sout(2,iret) = msin(2,1) - sout(2,iperm) sout(3,iret) = sout(1,iret) + sout(2,iret) sout(4,iret) = msin(4,1) sout(5,iret) = pret * 101325 c now set values of the two variables designated as output parameters ierr = usrutl_set_real_param('cp_prot', index, cp) if (ierr .ne. 0) then write(user_nhstry, *) 'error storing permeate prot conc' ifall=1 end if c ierr = usrutl_set_real_param('cr_prot', index, cr) if (ierr .ne. 0) then write(user_nhstry, *) 'error storing retentate prot conc' ifall=1 end if c return end查看更多
第1天
关注盖德视界
添加小助手
