git push -u origin main

2026-03-19 14:05:33 +08:00
commit 1e30b7bc63
739 changed files with 572150 additions and 0 deletions
@@ -0,0 +1,136 @@
+      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