SpectraRust/tlusty/extracted/nstpar.f
2026-03-19 14:05:33 +08:00

374 lines
14 KiB
Fortran

SUBROUTINE NSTPAR(FINSTD)
C ==========================
C
C setting up the default values of various input flags, and
C input of non-standard values of various input flags and parameters
C
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'ATOMIC.FOR'
INCLUDE 'MODELQ.FOR'
INCLUDE 'ITERAT.FOR'
INCLUDE 'ODFPAR.FOR'
INCLUDE 'ALIPAR.FOR'
COMMON/FLXAUX/T4,PGAS,PRAD,PGM,PRADM,ITGMAX,ITGMX0
common/freqcl/frmin,frmax,nfrecl
common/quasun/tqmprf,iquasi,nunalp,nunbet,nungam,nunbal
common/hediff/hcmass,radstr
common/irwint/iirwin
common/deridt/dert
common/icnrsp/iconrs
common/imucnn/imucon
common/ichndm/ichanm
common/ipricr/iprcrs,nprcrs
common/temlim/tfloor
common/derdif/dift,difp
common/adiaba/grdad0,itgrad
common/ifpzpa/ifpzev
common/moldat/moltab,irwtab
C
PARAMETER(MVAR=236)
PARAMETER(INPFI=4)
CHARACTER*(*) FINSTD
CHARACTER*6 PVALUE(MVAR)
CHARACTER*80 TEXT
CHARACTER VARNAM(MVAR)*6
CHARACTER*20 BLNK
CHARACTER*6 BLNK6
C
DATA VARNAM /'ISPLIN','IRTE ','IBC ','ILMCOR','ILPSCT',
* 'ILASCT','DJMAX ','NTRALI','IPSLTE','IOPTAB',
* 'IFMOL ','IFENTR','NFRECL','IFRYB ','IFRAYL',
* 'HCMASS','RADSTR','BERGFC','IHYDPR','IIRWIN',
* 'ICOMPT','IZSCAL','IBCHE ','IVISC ','ALPHAV',
* 'ZETA0 ','ZETA1 ','FRACTV','DMVISC','REYNUM',
* 'IFZ0 ','IHESO6','ICOLHN',
* 'IFALI ','IFPOPR','JALI ','IFRALI','IFALIH',
* 'IFPREC','IELCOR','ICHC ','IRSPLT','IATREF',
* 'MODREF','IACPP ','IACDP ','IFLEV ','IDLTE ',
* 'POPZER','POPZR2','POPZCH','NITZER','RADZER',
* 'IFDIEL','IFCHTR','SHFAC ',
* 'QTLAS ','ITLUCY','IACLT ','IACLDT','IFMOFF',
* 'IOVER ','ITLAS ','NITER ','NLAMBD','IFRSET',
* 'ND ','JIDS ','IDMFIX','ITNDRE',
* 'NMU ','IOSCOR',
* 'NELSC ','IHECOR','IBFINT','IRDER ',
* 'CHMAX ','ILDER ','IBPOPE','CHMAXT','NLAMT ',
* 'INTRPL','ICHANG','IFIXMO','IFIXDE',
* 'INHE ','INRE ','INPC ','INZD ','INSE ',
* 'INMP ','INDL ','NDRE ','TAUDIV','IDLST ',
* 'NRETC ','ICONV ','IPRESS','ITEMP ',
* 'ITMCOR','ICONRE','IDEEPC','NDCGAP','CRFLIM',
* 'IOPHMI','IOPH2P','IOPHEM','IOPCH ','IOPOH ',
* 'IOPH2M','IOH2H2','IOH2HE','IOH2H ','IOHHE ',
* 'IOPLYM',
* 'IOPOLD','IRWTAB','MOLTAB',
* 'IRSCT ','IRSCH2','IRSCHE','KEEPOP',
* 'IQUASI','NUNALP','NUNBET','TQMPRF',
* 'IACC ','IACD ','KSNG ','ITEK ','ORELAX',
* 'IWINBL','ICOMGR',
* 'ICRSW ','SWPFAC','SWPLIM','SWPINC',
* 'TAUFIR','TAULAS','ABROS0','TSURF ','ALBAVE',
* 'DION0 ','NDGREY','IDGREY','NCONIT','IPRING',
* 'DM1 ','ABPLA0','ABPMIN','ITGMAX','NNEWD ',
* 'IHM ','IH2 ','IH2P ','IFTENE',
* 'TRAD ','WDIL ',
* 'TDISK ','TFLOOR','TMOLIM',
* 'HMIX0 ','MLTYPE','VTB ','IPTURB','ILGDER',
* 'XGRAD ','STRL1 ','STRL2 ','STRLX ',
* 'FRCMAX','FRCMIN','FRLMAX','FRLMIN','CFRMAX',
* 'DFTAIL','NFTAIL','TSNU ','VTNU ','DDNU ',
* 'IELNU ','CNU1 ','CNU2 ','ISPODF',
* 'DPSILG','DPSILT','DPSILN','DPSILD',
* 'ICOMST','ICOMDE','ICOMBC','ICOMVE','ICOMRT',
* 'ICMDRA','KNISH ','FRLCOM','ICHCOO',
* 'NCFOR1','NCFOR2','NCCOUP','NCITOT','NCFULL',
* 'IFPRD ','XPDIV ','IFPZEV',
* 'IPRINI','IDCONZ','INTENS',
* 'ICOOLP','IPRIND','IPRINP','ICHCKP','IPOPAC',
* 'ILBC ','IUBC ','DERT ','ICONRS','IMUCON',
* 'IFPRAD','ICHANM','CUTLYM','CUTBAL','IHXENB',
* 'IHGOM ','HGLIM ','IPRCRS','NPRCRS','FRTLIM',
* 'DIFT ','DIFP ','GRDAD0','ITGRAD',
* 'IPRYBH','IPELCH','IPELDO','IPCONF'/
C
DATA PVALUE /' 0',' 0',' 3',' 3',' 1',
* ' 0',' 1.D-3',' 3',' 0',' 0',
* ' 0',' 1',' 0',' 0',' 1',
* ' 0.',' 0.',' 1.',' 0',' 1',
* ' 0',' 0',' 1',' 0',' 0.1',
* ' 0.0',' 0.0',' -1',' 0.01',' 0.',
* ' 9',' 0',' 0',
* ' 5',' 4',' 1',' 0',' 0',
* ' 1',' -1',' 1',' 1',' 1',
* ' 1',' 7',' 4',' 0',' 1000',
* '1.D-20','1.D-20','1.D-15',' 1','1.D-20',
* ' 0',' 0',' 0.',
* ' 1.D30',' 0',' 7',' 4',' 0',
* ' 1',' 100',' 30',' 2',' 0',
* ' 70',' 0',' 1',' 1',
* ' 3',' 0',
* ' 0',' 0',' 1',' 3',
* ' 1.D-3',' 0',' 1',' 0.01',' 1',
* ' 0',' 0',' 0',' 0',
* ' 1',' 2',' 3',' 0',' 4',
* ' 0',' 0',' 0',' 0.5',' 5',
* ' 0',' 0',' 0',' 0',
* ' 0',' 1',' 2',' 2',' 0.7',
* ' 1',' 1',' 1',' 1',' 1',
* ' 1',' 1',' 1',' 1',' 1',
* ' 0',
* ' 0',' 1',' 1',
* ' 1',' 1',' 1',' 0',
* ' 0',' 3',' 0',' 0.',
* ' 7',' 4',' 0',' 4',' 1.D0',
* ' -1',' 0',
* ' 0',' 1.D-1',' 1.D-3',' 3.D0',
* ' 1.D-7',' 316.0',' 0.4',' 0.',' 0.',
* ' 1.',' 0',' 0',' 0',' 0',
* ' 1.D-3',' 3.D-1',' 1.D-5',' 10',' 0',
* ' 0',' 0',' 0',' 0',
* ' 0.',' 0.',
* ' 0.',' 8000.',' 9000.',
* ' -1.',' 1',' 0.',' 1',' 0',
* ' 0.',' 0.001',' 0.02','1.D-10',
* ' 0.',' 1.D12',' 0.',' 1.D13',' 0.',
* ' 0.25',' 21',' 0.',' 0.',' 0.75',
* ' 0',' 4.5',' 3.',' 0',
* ' 10.',' 1.25',' 10.',' 1.25',
* ' 1',' 1',' 1',' 0',' 0',
* ' 0',' 0','8.2D14',' 1',
* ' 0',' 1',' 0',' 1',' 1',
* ' 0',' 3.D0',' 0',
* ' 0',' 31',' 10',
* ' 0',' 0',' 1',' 0',' 0',
* ' 0',' 0',' 0.01',' 10',' 10',
* ' 1',' 1',' 0.',' 0.',' 0',
* ' 0',' 1.D18',' 0',' 0','3.2880',
* ' 0.01',' 0.01',' 0.',' 0',
* ' 0',' 0',' 0',' 0'/
C
DATA BLNK/' '/,BLNK6/' '/
C
IF(FINSTD.NE.BLNK)
* OPEN(UNIT=INPFI,FILE=FINSTD,STATUS='UNKNOWN')
C
DO ID=1,MDEPTH
CRSW(ID)=UN
END DO
C
INDV=-1
C
C go through the input file line by line
c
write(6,601)
601 format(/' INPUT KEYWORD PARAMETERS:'/
* ' -------------------------')
10 CONTINUE
K0=1
READ(INPFI,500,END=70,ERR=70) TEXT
500 FORMAT(A)
WRITE(6,*) TEXT
20 CONTINUE
CALL GETWRD(TEXT,K0,K1,K2)
IF(K1.EQ.0) GO TO 60
K0=K2+2
IF(TEXT(K1:K2).EQ.'=') GO TO 20
INDV=-INDV
IF(INDV.EQ.1) THEN
DO I=1,MVAR
IF(TEXT(K1:K2).EQ.VARNAM(I)(1:K2-K1+1)) GO TO 50
END DO
CALL GETWRD(TEXT,K0,K1,K2)
IF(K1.EQ.0) THEN
K0=1
45 READ(INPFI,500,END=70) TEXT
CALL GETWRD(TEXT,K0,K1,K2)
IF(K1.EQ.0) GO TO 45
END IF
K0=K2+2
INDV=-INDV
GO TO 20
50 CONTINUE
IVAR=I
ELSE
PVALUE(IVAR)=BLNK6
PVALUE(IVAR)(6-K2+K1:6)=TEXT(K1:K2)
END IF
GO TO 20
60 CONTINUE
GO TO 10
70 CONTINUE
C
DO I=1,MVAR
WRITE(84,684) PVALUE(I)
684 FORMAT(1X,A)
END DO
C
CLOSE(UNIT=84)
REWIND(84)
READ(84,*)
* ISPLIN,IRTE ,IBC ,ILMCOR,ILPSCT,
* ILASCT,DJMAX ,NTRALI,IPSLTE,IOPTAB,
* IFMOL ,IFENTR,NFRECL,IFRYB ,IFRAYL,
* HCMASS,RADSTR,BERGFC,IHYDPR,IIRWIN,
* ICOMPT,IZSCAL,IBCHE ,IVISC ,ALPHAV,
* ZETA0 ,ZETA1 ,FRACTV,DMVISC,REYNUM,
* IFZ0 ,IHESO6,ICOLHN,
* IFALI ,IFPOPR,JALI ,IFRALI,IFALIH,
* IFPREC,IELCOR,ICHC ,IRSPLT,IATREF,
* MODREF,IACPP ,IACDP ,IFLEV ,IDLTE ,
* POPZER,POPZR2,POPZCH,NITZER,RADZER,
* IFDIEL,IFCHTR,SHFAC ,
* QTLAS ,ITLUCY,IACLT ,IACLDT,IFMOFF,
* IOVER ,ITLAS ,NITER ,NLAMBD,IFRSET,
* ND ,JIDS ,IDMFIX,ITNDRE,
* NMU ,IOSCOR,
* NELSC ,IHECOR,IBFINT,IRDER ,
* CHMAX ,ILDER ,IBPOPE,CHMAXT,NLAMT ,
* INTRPL,ICHANG,IFIXMO,IFIXDE,
* INHE ,INRE ,INPC ,INZD ,INSE ,
* INMP ,INDL ,NDRE ,TAUDIV,IDLST ,
* NRETC ,ICONV ,IPRESS,ITEMP ,
* ITMCOR,ICONRE,IDEEPC,NDCGAP,CRFLIM,
* IOPHMI,IOPH2P,IOPHEM,IOPCH ,IOPOH ,
* IOPH2M,IOH2H2,IOH2HE,IOH2H ,IOHHE ,
* IOPLYM,
* IOPOLD,IRWTAB,MOLTAB,
* IRSCT ,IRSCH2,IRSCHE,KEEPOP,
* IQUASI,NUNALP,NUNBET,TQMPRF,
* IACC ,IACD ,KSNG ,ITEK ,ORELAX,
* IWINBL,ICOMGR,
* ICRSW ,SWPFAC,SWPLIM,SWPINC,
* TAUFIR,TAULAS,ABROS0,TSURF ,ALBAVE,
* DION0 ,NDGREY,IDGREY,NCONIT,IPRING,
* DM1 ,ABPLA0,ABPMIN,ITGMAX,NNEWD ,
* IHM ,IH2 ,IH2P ,IFTENE,
* TRAD ,WDIL ,
* TDISK ,TFLOOR,TMOLIM,
* HMIX0 ,MLTYPE,VTB ,IPTURB,ILGDER,
* XGRAD ,STRL1 ,STRL2 ,STRLX ,
* FRCMAX,FRCMIN,FRLMAX,FRLMIN,CFRMAX,
* DFTAIL,NFTAIL,TSNU ,VTNU ,DDNU ,
* IELNU ,CNU1 ,CNU2 ,ISPODF,
* DPSILG,DPSILT,DPSILN,DPSILD,
* ICOMST,ICOMDE,ICOMBC,ICOMVE,ICOMRT,
* ICMDRA,KNISH ,FRLCOM,ICHCOO,
* NCFOR1,NCFOR2,NCCOUP,NCITOT,NCFULL,
* IFPRD ,XPDIV ,IFPZEV,
* IPRINI,IDCONZ,INTENS,
* ICOOLP,IPRIND,IPRINP,ICHCKP,IPOPAC,
* ILBC ,IUBC ,DERT ,ICONRS,IMUCON,
* IFPRAD,ICHANM,CUTLYM,CUTBAL,IHXENB,
* IHGOM ,HGLIM ,IPRCRS,NPRCRS,FRTLIM,
* DIFT ,DIFP ,GRDAD0,ITGRAD,
* IPRYBH,IPELCH,IPELDO,IPCONF
C
IF(LTGREY) ISPODF=0
IF(LTE) IFLEV=1
IF(IFRYB.GE.1) IDLST=0
LCHC=.FALSE.
IF(ICHC.EQ.1) LCHC=.TRUE.
NFFIX=IFRALI
IF(IACC.LE.4) IACC=7
if(frtlim.lt.1.e6) frtlim=frtlim*1.e15
if(frcmax.lt.1.e6) frcmax=frcmax*1.e15
if(frlmax.lt.1.e6) frlmax=frlmax*1.e15
if(frcmin.lt.1.e6) frcmin=frcmin*1.e13
if(frlmin.lt.1.e6) frlmin=frlmin*1.e13
IF(FRLMAX.EQ.0.) FRLMAX=max(1.D11*CNU1*TEFF,3.288e15)
if(idisk.eq.0.and.cfrmax.eq.0.) cfrmax=2.
if(trad.ne.0.) iwinbl=-1
if(nitzer.gt.itek) nitzer=itek
if(nitzer.gt.iacc-iacd) nitzer=iacc-iacd
if(ielhm.gt.0) iophmi=0
if(teff.gt.15000.) then
ioph2p=0
iopch=0
iopoh=0
irsch2=0
ioph2m=0
ioh2h2=0
ioh2he=0
ioh2h=0
iohhe=0
end if
iopadd=iophmi+ioph2p+iophem+iopch+iopoh
iopadd=iopadd+ioph2m+ioh2h2+ioh2he+ioh2h+iohhe
iopadd=iopadd+irsct+irsch2+irsche
c
if(ioptab.lt.0.or.ifmol.gt.0) ielcor=-1
c
RRDIL=un
IF(IDISK.EQ.0) IFZ0=-1
ITGMX0=ITGMAX
DO ITL=1,NITER+1
NITLAM(ITL)=0
END DO
IF(NLAMBD.LT.0) THEN
NLAMBD=-NLAMBD
IF(LTE) NLAMBD=1
DO ITL=1,12
NITLAM(ITL)=NLAMBD
END DO
DO ITL=13,NITER+1
NITLAM(ITL)=2
END DO
ELSE IF(NLAMBD.GT.0) THEN
IF(LTE) NLAMBD=1
DO ITL=1,NITER+1
NITLAM(ITL)=NLAMBD
END DO
END IF
IF(ILMCOR.GE.3) ILPSCT=1
C
IF(IDISK.EQ.1.AND.INZD.EQ.0.AND.IZSCAL.EQ.0.AND.IVISC.LE.1) THEN
if(ifryb.eq.0) then
INZD=4
INSE=5
end if
END IF
C
IF(IFIXMO.GT.0) THEN
INHE=0
INRE=0
INPC=0
INZD=0
INSE=1
END IF
c
IF(IFIXDE.GT.0) THEN
INHE=1
INRE=0
INPC=2
INZD=0
INSE=3
END IF
C
if(iprcrs.gt.0) then
niter=0
nlambd=1
end if
C
c initialize the convection parameters
c
aconml=1./8.
bconml=half
cconml=16.
if(mltype.eq.2) then
aconml=1.
bconml=2.
cconml=16.
end if
nungam=0
nunbal=0
if(iquasi.gt.0) call getlal
c
if(nd.gt.mdepth) CALL QUIT('nd.gt.mdepth',nd,mdepth)
if(ndgrey.gt.mdepth) CALL QUIT('ndgrey.gt.mdepth',ndgrey,mdepth)
if(nlambd.gt.mlambd) CALL QUIT('nlambd.gt.mlambd',nlambd,mlambd)
if(iacc.le.2) CALL QUIT('Ng too early',iacc,iacc)
if(nmu.gt.mmu) CALL QUIT('nmu.gt.mmu',nmu,mmu)
RETURN
END