input.for (7268B)
1 subroutine read_opt_prop_file(infile,Nw,Nlev,Nlay, 2 & Tsurf,Tspace,pressure, 3 & temperature,height,x_h2o_nominal,x_h2o_tab, 4 & lw_emissivity,sw_emissivity, 5 & Nb_lw,nu_lo_lw,nu_hi_lw,Ng_lw,w_lw, 6 & Nb_sw,nu_lo_sw,nu_hi_sw,Ng_sw,w_sw, 7 & ka_lw_nominal,ka_lw_tab, 8 & ka_sw_nominal,ka_sw_tab, 9 & ks_sw_nominal,ks_sw_tab) 10 implicit none 11 include 'max.inc' 12 include 'formats.inc' 13 c 14 c Purpose: to read the optical properties file for the atmosphere 15 c 16 c Input: 17 c + infile: file to read 18 c 19 c Output: 20 c + Nw: number of tabulation points of water vapor concentration 21 c + Nlev: number of atmospheric levels 22 c + Nlay: number of atmospheric layers 23 c + Tsurf: temperature of the ground [K] 24 c + Tspace: temperature of the ground [K] 25 c + pressure: pressure at each level [Pa] 26 c + temperature: temperature at each level [K] 27 c + height: altitude at each level [m] 28 c + x_h2o_nominal: molar fraction of H2O at each level for the nominal profile 29 c + x_h2o_tab: molar fraction of H2O at each level for each tabulation point 30 c + lw_emissivity: LW emissivity 31 c + sw_emissivity: SW emissivity 32 c + Nb_lw: number of LW spectral intervals 33 c + nu_lo_lw: lower wavenumber limit of each LW interval [cm^-1] 34 c + nu_hi_lw: upper wavenumber limit of each LW interval [cm^-1] 35 c + Ng_lw: number of quadrature points in each LW interval 36 c + w_lw: quadrature weights for each LW interval 37 c + Nb_sw: number of SW spectral intervals 38 c + nu_lo_sw: lower wavenumber limit of each SW interval [cm^-1] 39 c + nu_hi_sw: upper wavenumber limit of each SW interval [cm^-1] 40 c + Ng_sw: number of quadrature points in each SW interval 41 c + w_sw: quadrature weights for each SW interval 42 c + ka_lw_nominal: LW absorption coefficient [m^-1] for the nominal profile 43 c + ka_lw_tab: LW absorption coefficient [m^-1] for each tabulation point 44 c + ka_sw_nominal: SW absorption coefficient [m^-1] for the nominal profile 45 c + ka_sw_tab: SW absorption coefficient [m^-1] for each tabulation point 46 c + ks_sw_nominal: SW scattering coefficient [m^-1] for the nominal profile 47 c + ks_sw_tab: SW scattering coefficient [m^-1] for each tabulation point 48 c 49 c I/O 50 character*(Nchar_mx) infile 51 integer Nw,Nlev,Nlay 52 double precision pressure(1:Nlev_mx) 53 double precision Tsurf,Tspace 54 double precision temperature(1:Nlev_mx) 55 double precision height(1:Nlev_mx) 56 double precision x_h2o_nominal(1:Nlay_mx) 57 double precision x_h2o_tab(1:Nlay_mx,1:Nw_mx) 58 double precision lw_emissivity,sw_emissivity 59 double precision ka_lw_nominal(1:Ngpoints_lw_mx,1:Nlev_mx) 60 double precision ka_lw_tab(1:Ngpoints_lw_mx,1:Nlev_mx,1:Nw_mx) 61 double precision ka_sw_nominal(1:Ngpoints_sw_mx,1:Nlev_mx) 62 double precision ka_sw_tab(1:Ngpoints_sw_mx,1:Nlev_mx,1:Nw_mx) 63 double precision ks_sw_nominal(1:Ngpoints_sw_mx,1:Nlev_mx) 64 double precision ks_sw_tab(1:Ngpoints_sw_mx,1:Nlev_mx,1:Nw_mx) 65 integer Nb_lw 66 double precision nu_lo_lw(1:16) 67 double precision nu_hi_lw(1:16) 68 integer Ng_lw(1:16) 69 double precision w_lw(1:16,1:20) 70 integer Nb_sw 71 double precision nu_lo_sw(1:14) 72 double precision nu_hi_sw(1:14) 73 integer Ng_sw(1:14) 74 double precision w_sw(1:14,1:20) 75 c temp 76 logical file_ex 77 integer ilay,ilev,ib,ig,i,iw 78 c label 79 character*(Nchar_mx) label 80 label='subroutine read_opt_prop_file' 81 82 inquire(file=trim(infile), exist=file_ex) 83 if (file_ex) then 84 write(*,*) 'Reading file: ',trim(infile) 85 else 86 call error(label) 87 write(*,*) 'File not found:' 88 write(*,*) trim(infile) 89 stop 90 endif 91 92 open(11,file=trim(infile)) 93 read(11,*) 94 read(11,*) Nlev 95 read(11,*) 96 read(11,*) Nlay 97 read(11,*) 98 read(11,*) Tsurf 99 Tspace=3.0D+0 ! K 100 read(11,*) 101 do ilev=1,Nlev 102 read(11,*) pressure(ilev) 103 enddo ! ilev 104 read(11,*) 105 do ilev=1,Nlev 106 read(11,*) temperature(ilev) 107 enddo ! ilev 108 read(11,*) 109 do ilev=1,Nlev 110 read(11,*) height(ilev) 111 enddo ! ilev 112 read(11,*) 113 do ilay=1,Nlay 114 read(11,*) x_h2o_nominal(ilay) 115 enddo ! ilay 116 read(11,*) 117 read(11,*) Nw 118 do iw=1,Nw 119 read(11,*) 120 do ilay=1,Nlay 121 read(11,*) x_h2o_tab(ilay,iw) 122 enddo ! ilay 123 enddo ! iw 124 read(11,*) 125 read(11,*) lw_emissivity 126 read(11,*) 127 read(11,*) sw_emissivity 128 read(11,*) 129 read(11,*) Nb_lw 130 read(11,*) 131 read(11,*) Nb_sw 132 do ib=1,Nb_lw 133 read(11,*) 134 read(11,*) 135 read(11,*) nu_lo_lw(ib) 136 read(11,*) 137 read(11,*) nu_hi_lw(ib) 138 read(11,*) 139 read(11,*) Ng_lw(ib) 140 read(11,*) 141 do ig=1,Ng_lw(ib) 142 read(11,*) w_lw(ib,ig) 143 enddo ! ig 144 enddo ! ib 145 c SW: per interval 146 do ib=1,Nb_sw 147 read(11,*) 148 read(11,*) 149 read(11,*) nu_lo_sw(ib) 150 read(11,*) 151 read(11,*) nu_hi_sw(ib) 152 read(11,*) 153 read(11,*) Ng_sw(ib) 154 read(11,*) 155 do ig=1,Ng_sw(ib) 156 read(11,*) w_sw(ib,ig) 157 enddo ! ig 158 enddo ! ib 159 c 160 c LW: per interval, per g-point 161 i=0 162 do ib=1,Nb_lw 163 do ig=1,Ng_lw(ib) 164 i=i+1 165 read(11,*) 166 do ilay=1,Nlay 167 read(11,*) ka_lw_nominal(i,ilay) 168 enddo ! ilay 169 do iw=1,Nw 170 read(11,*) 171 do ilay=1,Nlay 172 read(11,*) ka_lw_tab(i,ilay,iw) 173 enddo ! ilay 174 enddo ! iw 175 enddo ! ig 176 enddo ! ib 177 c 178 c SW: per interval, per g-point 179 c absorption coefficient 180 i=0 181 do ib=1,Nb_sw 182 do ig=1,Ng_sw(ib) 183 i=i+1 184 read(11,*) 185 do ilay=1,Nlay 186 read(11,*) ka_sw_nominal(i,ilay) 187 enddo ! ilay 188 do iw=1,Nw 189 read(11,*) 190 do ilay=1,Nlay 191 read(11,*) ka_sw_tab(i,ilay,iw) 192 enddo ! ilay 193 enddo ! iw 194 enddo ! ig 195 enddo ! ib 196 c 197 c scattering coefficient 198 i=0 199 do ib=1,Nb_sw 200 do ig=1,Ng_sw(ib) 201 i=i+1 202 read(11,*) 203 do ilay=1,Nlay 204 read(11,*) ks_sw_nominal(i,ilay) 205 enddo ! ilay 206 do iw=1,Nw 207 read(11,*) 208 do ilay=1,Nlay 209 read(11,*) ks_sw_tab(i,ilay,iw) 210 enddo ! ilay 211 enddo ! iw 212 enddo ! ig 213 enddo ! ib 214 close(11) 215 216 return 217 end 218