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

137 lines
3.9 KiB
Fortran

SUBROUTINE NSTPAR(FINSTD)
C ==========================
C
C settiing up the default values of various input flags, and
C input of non-standard values of various input flags and parameters
C
INCLUDE 'PARAMS.FOR'
INCLUDE 'MODELP.FOR'
INCLUDE 'SYNTHP.FOR'
common/hhebrd/sthe,nunhhe
common/gompar/hglim,ihgom
common/brdstd/gsstd,gwstd
C
PARAMETER(MVAR=44)
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 /'IATREF',
* 'BERGFC','IHYDPR','NUNHHE','STHE ',
* 'ND ','NFREQS','IBFAC ',
* 'INTRPL','ICHANG','IFEOS ',
* 'IOPHMI','IOPH2P','IOPHEM','IOPCH ','IOPOH ',
* 'IOPH2M','IOH2H2','IOH2HE','IOH2H1','IOHHE ',
* 'IRSCT ','IRSCH2','IRSCHE',
* 'TRAD ','WDIL ',
* 'VTB ','IFMOL','TMOLIM',
* 'MOLTAB','IRWTAB','IIRWIN','IPFEXO',
* 'CUTLYM','CUTBAL','IHXENB',
* 'GSSTD ','GWSTD ',
* 'IHGOM ','HGLIM ',
* 'ERANGE',
* 'ISPICK','ILPICK','IPPICK'/
C
DATA PVALUE /' 1',
* ' 1.D0',' 0',' 0',' 1.e19',
* ' 70',' 120',' 0',
* ' 0',' 0',' 0',
* ' 1',' 1',' 1',' 1',' 1',
* ' 1',' 1',' 1',' 1',' 1',
* ' 1',' 1',' 1',
* ' 0.',' 0.',
* ' 2.',' 1',' 9000.',
* ' 1',' 1',' 1',' 1',
* ' 0.',' 0.',' 0',
* '3.1e-5','1.0e-7',
* ' 0',' 1.e18',
* ' 0.10',
* ' 1',' 1',' 1'/
C
DATA BLNK/' '/,BLNK6/' '/
C
IF(FINSTD.NE.BLNK)
* OPEN(UNIT=INPFI,FILE=FINSTD,STATUS='UNKNOWN')
C
INDV=-1
C
C go through the input file line by line
c
write(6,601)
601 format(/' INPUT KEYWORD PARAMETERS:'/
* ' -------------------------')
c
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 40 I=1,MVAR
IF(TEXT(K1:K2).EQ.VARNAM(I)(1:K2-K1+1)) GO TO 50
40 CONTINUE
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,*)
* IATREF,
* BERGFC,IHYDPR,NUNHHE,STHE ,
* ND ,NFREQS,IBFAC ,
* INTRPL,ICHANG,IFEOS ,
* IOPHMI,IOPH2P,IOPHEM,IOPCH ,IOPOH ,
* IOPH2M,IOH2H2,IOH2HE,IOH2H1,IOHHE ,
* IRSCT ,IRSCH2,IRSCHE,
* TRAD ,WDIL ,
* VTB ,IFMOL ,TMOLIM,
* MOLTAB,IRWTAB,IIRWIN,IPFEXO,
* CUTLYM,CUTBAL,IHXENB,
* GSSTD ,GWSTD ,
* IHGOM ,HGLIM ,
* ERANGE,
* ISPICK,ILPICK,IPPICK
C
if(imode.le.-3) then
irsct=0
irsche=0
irsch2=0
end if
C
RETURN
END