1 2 SUBROUTINE GASDEP 3 !*********************************************************************** 4 ! GASDEP Module of ISC2 Model 5 ! 6 ! PURPOSE: Processes Deposition Parameters for Gases 7 ! 8 ! PROGRAMMER: R. W. Brode, PES, Inc. 9 ! 10 ! DATE: May 16, 1996 11 ! 12 ! MODIFIED: Apply range check on input parameters. 13 ! R.W. Brode, MACTEC (f/k/a PES), Inc., 10/26/2004 14 ! 15 ! INPUTS: Input Runstream Image Parameters 16 ! 17 ! OUTPUTS: Dry Deposition Parameters for Gases 18 ! 19 ! CALLED FROM: SOCARD 20 !*********************************************************************** 21 22 ! Variable Declarations 23 USE MAIN1 24 IMPLICIT NONE 25 CHARACTER MODNAM*12 26 27 SAVE 28 INTEGER :: I , IH , IL , ISDX 29 CHARACTER LID*8 , HID*8 , LID1*8 , LID2*8 , HID1*8 , HID2*8 30 CHARACTER(LEN=ILEN_FLD) :: SOID 31 LOGICAL FIND , INGRP , RMARK 32 33 ! Variable Initializations 34 FIND = .FALSE. ! 0 35 INGRP = .FALSE. 36 MODNAM = 'GASDEP' 37 38 ! Set logical LDGAS to indicate processing of gaseous deposition 39 LDGAS = .TRUE. 40 LWGAS = .TRUE. 41 42 ! Check the Number of Fields 43 IF ( IFC.LE.2 ) THEN 44 ! Error Message: No Parameters 45 CALL ERRHDL(PATH,MODNAM,'E','200',KEYWRD) ! 0 46 GOTO 999 47 ELSEIF ( IFC.LT.7 ) THEN 48 ! Error Message: Not Enough Parameters 49 CALL ERRHDL(PATH,MODNAM,'E','201',KEYWRD) ! 0 50 GOTO 999 51 ELSEIF ( IFC.GT.7 ) THEN 52 ! Error Message: Too Many Parameters 53 CALL ERRHDL(PATH,MODNAM,'E','202',KEYWRD) ! 0 54 GOTO 999 55 ENDIF 56 57 ! Get The Source ID(s) 58 SOID = FIELD(3) ! 0 59 CALL FSPLIT(PATH,KEYWRD,SOID,ILEN_FLD,'-',RMARK,LID,HID) 60 61 IF ( LID.EQ.HID ) THEN 62 ! Search For The Index 63 CALL SINDEX(SRCID,NSRC,SOID,ISDX,FIND) ! 0 64 IF ( FIND ) THEN 65 SOGAS(ISDX) = 'Y' ! 0 66 ! Read Dry Deposition Parameters 67 ! Change Them To Numbers 68 69 ! First Get Gas Diffusivity (cm^2/s) 70 CALL STONUM(FIELD(4),ILEN_FLD,FNUM,IMIT) 71 ! Check The Numerical Field 72 IF ( IMIT.EQ.-1 ) THEN 73 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 74 ELSEIF ( FNUM.LE.0.0 ) THEN 75 CALL ERRHDL(PATH,MODNAM,'E','380','PDIFF') ! 0 76 ENDIF 77 ! Assign The Field 78 PDIFF(ISDX) = FNUM ! 0 79 80 !PES --- Next Get Diffusivity in Water (cm^2/s) 81 CALL STONUM(FIELD(5),ILEN_FLD,FNUM,IMIT) 82 ! Check The Numerical Field 83 IF ( IMIT.EQ.-1 ) THEN 84 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 85 ELSEIF ( FNUM.LE.0.0 ) THEN 86 CALL ERRHDL(PATH,MODNAM,'E','380','PDIFFW') ! 0 87 ENDIF 88 ! Assign The Field 89 PDIFFW(ISDX) = FNUM ! 0 90 91 ! Now Get Lipid Cuticle Resistence for Individual Leaves (RCLI) 92 CALL STONUM(FIELD(6),ILEN_FLD,FNUM,IMIT) 93 ! Check The Numerical Field 94 IF ( IMIT.EQ.-1 ) THEN 95 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 96 ELSEIF ( FNUM.LE.0.0 ) THEN 97 CALL ERRHDL(PATH,MODNAM,'E','380','RCLI') ! 0 98 ENDIF 99 ! Assign The Field 100 RCLI(ISDX) = FNUM ! 0 101 102 ! Get the Henry's Law Constant 103 CALL STONUM(FIELD(7),ILEN_FLD,FNUM,IMIT) 104 ! Check The Numerical Field 105 IF ( IMIT.EQ.-1 ) THEN 106 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 107 ELSEIF ( FNUM.LE.0.0 ) THEN 108 CALL ERRHDL(PATH,MODNAM,'E','380','HENRY') ! 0 109 ENDIF 110 ! Assign The Field 111 HENRY(ISDX) = FNUM ! 0 112 113 ELSE 114 ! WRITE Error Message ! Source Location Has Not Been Identified 115 CALL ERRHDL(PATH,MODNAM,'E','300',KEYWRD) ! 0 116 ENDIF 117 ELSE 118 ! First Check Range for Upper Value < Lower Value 119 CALL SETIDG(LID,LID1,IL,LID2) ! 0 120 CALL SETIDG(HID,HID1,IH,HID2) 121 IF ( (HID1.LT.LID1) .OR. (IH.LT.IL) .OR. (HID2.LT.LID2) ) THEN 122 ! WRITE Error Message: Invalid Range, Upper < Lower 123 CALL ERRHDL(PATH,MODNAM,'E','203','SRCRANGE') ! 0 124 GOTO 999 125 ENDIF 126 DO I = 1 , NUMSRC ! 0 127 ! See Whether It's In The Group 128 CALL ASNGRP(SRCID(I),LID,HID,INGRP) ! 0 129 IF ( INGRP ) THEN 130 ISDX = I ! 0 131 SOGAS(ISDX) = 'Y' 132 ! Read Dry Deposition Parameters 133 ! Change Them To Numbers 134 135 ! First Get Gas Diffusivity 136 CALL STONUM(FIELD(4),ILEN_FLD,FNUM,IMIT) 137 ! Check The Numerical Field 138 IF ( IMIT.EQ.-1 ) THEN 139 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 140 ELSEIF ( FNUM.LE.0.0 ) THEN 141 CALL ERRHDL(PATH,MODNAM,'E','380','PDIFF') ! 0 142 ENDIF 143 ! Assign The Field 144 PDIFF(ISDX) = FNUM ! 0 145 146 !PES --- Next Get Diffusivity in Water (cm^2/s) 147 CALL STONUM(FIELD(5),ILEN_FLD,FNUM,IMIT) 148 ! Check The Numerical Field 149 IF ( IMIT.EQ.-1 ) THEN 150 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 151 ELSEIF ( FNUM.LE.0.0 ) THEN 152 CALL ERRHDL(PATH,MODNAM,'E','380','PDIFFW') ! 0 153 ENDIF 154 ! Assign The Field 155 PDIFFW(ISDX) = FNUM ! 0 156 157 ! Now Get Lipid Cuticle Resistence for Individual Leaves (RCLI) 158 CALL STONUM(FIELD(6),ILEN_FLD,FNUM,IMIT) 159 ! Check The Numerical Field 160 IF ( IMIT.EQ.-1 ) THEN 161 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 162 ELSEIF ( FNUM.LE.0.0 ) THEN 163 CALL ERRHDL(PATH,MODNAM,'E','380','RCLI') ! 0 164 ENDIF 165 ! Assign The Field 166 RCLI(ISDX) = FNUM ! 0 167 168 ! Get the Henry's Law Constant 169 CALL STONUM(FIELD(7),ILEN_FLD,FNUM,IMIT) 170 ! Check The Numerical Field 171 IF ( IMIT.EQ.-1 ) THEN 172 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 173 ELSEIF ( FNUM.LE.0.0 ) THEN 174 CALL ERRHDL(PATH,MODNAM,'E','380','HENRY') ! 0 175 ENDIF 176 ! Assign The Field 177 HENRY(ISDX) = FNUM ! 0 178 179 ENDIF 180 ENDDO 181 ENDIF 182 183 999 CONTINUE ! 0 184 END
HyperKWIC - Version 1.00DD executed at 20:00 on 1 Mar 2018 | Personal or Academic or Evaluation User | Free for Non-Commercial, Non-Government Use