0000001 subroutine frstz2(z,thenot,fsx,f1,f2,ncp1) 0000002 c ****************************************************************** 0000003 c subroutine frstz2 0000004 c 0000005 c purpose 0000006 c this routine is used to calculate the zero order source 0000007 c functions for a parallel plane atmos. model. 0000008 c 0000009 c method 0000010 c the zero order source functions are computed by calculating 0000011 c the intensity of the incident solar radiation at each source 0000012 c function level using attenuation factors calculated for a 0000013 c parallel plane atmosphere. 0000014 c 0000015 c calling sequence 0000016 c call frstz2(z,thnot,fsx,f1,f2,ncp1) 0000017 c 0000018 c variable type i/o description 0000019 c -------- ---- --- ----------- 0000020 c 0000021 c z(202) r*8 o zero order reduced source functions 0000022 c thnot r*8i current solar zenith angle 0000023 c fsx r*8 o direct flux reaching ground 0000024 c f1 r*8 o constant 0000025 c f2 r*8 o computational constant 0000026 c ncp1 i*4 i # levels in model atmos. 0000027 c 0000028 c analysis and programming 0000029 c k. f. klenk , p. m. smith sasc aug 77 0000030 c 0000031 c modifications (date name purpose) 0000032 c last modified by zia ahmad 0000033 c purpose: to include the effect of molecular anisotropy 0000034 c 0000035 c last modified 03/14/95...dave flittner 0000036 c purpose: set pressure scale height used in gravity correction 0000037 c to rayleigh scattering od. Create new variable pscaleforg and 0000038 c pass in common block consts. 0000039 c*********************************************************************** 0000040 c 0000041 implicit integer*4(i-n),real*8 (a-h,o-z) 0000042 c real *8 h(487),ps(487),xs(487),dxs(487),zs(487),cofx(4,487) 0000043 real *8 z(202) 0000044 c 0000045 include "consts.inc" 0000046 include "thkns.inc" 0000047 include "chpmn.inc" 0000048 include "out.inc" 0000049 include "out.inc" Warning on line 2 of out.inc: variable sb already declared Warning on line 2 of out.inc: variable qr already declared Warning on line 2 of out.inc: variable tnstr already declared Warning on line 2 of out.inc: variable eizero already declared Warning on line 2 of out.inc: variable eiaz1 already declared Warning on line 2 of out.inc: variable eiaz2 already declared Warning on line 2 of out.inc: variable gg already declared Warning on line 2 of out.inc: variable fs already declared Warning on line 2 of out.inc: variable totint already declared Error on line 3 of out.inc: Declaration error for sb: incompatible common declaration Error on line 3 of out.inc: Declaration error for qr: incompatible common declaration Error on line 3 of out.inc: Declaration error for tnstr: incompatible common declaration Error on line 3 of out.inc: Declaration error for eizero: incompatible common declaration Error on line 3 of out.inc: Declaration error for eiaz1: incompatible common declaration Error on line 3 of out.inc: Declaration error for eiaz2: incompatible common declaration Error on line 3 of out.inc: Declaration error for gg: incompatible common declaration Error on line 3 of out.inc: Declaration error for fs: incompatible common declaration Error on line 3 of out.inc: Declaration error for totint: incompatible common declaration 0000050 c 0000051 c new statement 0000052 include "depolt.inc" 0000053 c end of new statement 0000054 c 0000055 amuo = dcos(thenot*cnvrt) 0000056 if (thenot .eq. 90.0) amuo = 0. 0000057 amuosq = amuo**2 0000058 sn = dsqrt(1.-amuosq) 0000059 c new statements 0000060 if(ipol.eq.0)then 0000061 f1 = 0.1875d0*(1.d0 + amuosq) 0000062 f2 = 0.1875d0*sq2*(1.d0 - amuosq) 0000063 else 0000064 f1=0.25d0*q1*(1.0d0+amuosq+2.0d0*q) 0000065 f2=0.25d0*q1*delp*(1.0d0-amuosq) 0000066 endif 0000067 c*****parallel plane atmosphere 0000068 do 200 j=1,ncp1 0000069 z(j)=dexp(-tt(j)/amuo) 0000070 200 continue 0000071 c 0000072 fsx=amuo*z(ncp1) 0000073 fs=fsx 0000074 return 0000075 end INCLUDE FILES FileNo File name 1 consts.inc 2 thkns.inc 3 chpmn.inc 4 out.inc 5 depolt.inc ENTRY POINTS Name Type BlockNo frstz2 SUBR 3 FUNCTION AND SUBROUTINE REFERENCES Name Type ProcType References dcos INTRINSIC 55 dexp INTRINSIC 69 dsqrt INTRINSIC 58 frstz2 SUBR 1D COMMON BLOCKS Name Size BlockNo chpmn_ 7824 9 consts_ 104 5 depolt_ 68 14 out_ 3256 11 thkns_ 8888 7 VARIABLES REFERENCES Name Type Dimension Class Storage BlockNo Offset References amuo R*8 VAR AUTO 3 8 55= 56= 57 69 72 amuosq R*8 VAR AUTO 3 16 57= 58 61 62 64 65 c1415 R*8 VAR COMMON 5 72 1-2D c215 R*8 VAR COMMON 5 48 1-2D c2815 R*8 VAR COMMON 5 80 1-2D c38sq2 R*8 VAR COMMON 5 64 1-2D c815 R*8 VAR COMMON 5 56 1-2D chpn R*8 VAR COMMON 9 0 3-2D 3-3D chxn R*8 VAR COMMON 9 8 3-2D 3-3D cnvrt R*8 VAR COMMON 5 8 1-2D 55 cons R*8 VAR COMMON 5 32 1-2D delp R*8 VAR COMMON 14 40 5-3D 5-4D 65 dtsp R*8 (202) VAR COMMON 7 5656 2-2D 2-3D dtts R*8 (202) VAR COMMON 7 7272 2-2D 2-3D dxs R*8 (487) VAR COMMON 9 3928 3-2D 3-3D eiaz1 R*8 (15,8) VAR COMMON 11 360 4-2D 4-3D 4-2D 4-3D eiaz2 R*8 (15,8) VAR COMMON 11 1320 4-2D 4-3D 4-2D 4-3D eizero R*8 (15) VAR COMMON 11 240 4-2D 4-3D 4-2D 4-3D f1 R*8 VAR ARG 1D 61= 64= f2 R*8 VAR ARG 1D 62= 65= fs R*8 VAR COMMON 11 2288 4-2D 4-3D 4-2D 4-3D 73= fsx R*8 VAR ARG 1D 72= 73 gama R*8 VAR COMMON 14 8 5-3D 5-4D gg R*8 VAR COMMON 11 2280 4-2D 4-3D 4-2D 4-3D ipol I*4 VAR COMMON 14 64 5-2D 5-4D 60 j I*4 VAR AUTO 3 36 68= 69(2) 70= kskip I*4 VAR COMMON 5 100 1-2D ncp1 I*4 VAR ARG 1D 68 72 numek I*4 VAR COMMON 5 96 1-2D pi R*8 VAR COMMON 5 0 1-2D pscaleforg R*8 VAR COMMON 5 88 1-2D q R*8 VAR COMMON 14 16 5-3D 5-4D 64 q1 R*8 VAR COMMON 14 24 5-3D 5-4D 64 65 q12s R*8 VAR COMMON 14 56 5-3D 5-4D q2 R*8 VAR COMMON 14 32 5-3D 5-4D qr R*8 (11) VAR COMMON 11 32 4-2D 4-3D 4-2D 4-3D r R*8 VAR COMMON 5 16 1-2D rhon R*8 VAR COMMON 14 0 5-3D 5-4D rinv R*8 VAR COMMON 5 24 1-2D sb R*8 (4) VAR COMMON 11 0 4-2D 4-3D 4-2D 4-3D sdp R*8 VAR COMMON 14 48 5-3D 5-4D sn R*8 VAR AUTO 3 32 58= sq2 R*8 VAR COMMON 5 40 1-2D 62 sqchp R*8 VAR COMMON 9 16 3-2D 3-3D sqchx R*8 VAR COMMON 9 24 3-2D 3-3D thenot R*8 VAR ARG 1D 55 56 tnstr R*8 (15) VAR COMMON 11 120 4-2D 4-3D 4-2D 4-3D totint R*8 (15,8) VAR COMMON 11 2296 4-2D 4-3D 4-2D 4-3D tsl R*8 (101) VAR COMMON 7 0 2-2D 2-3D tt R*8 (202) VAR COMMON 7 808 2-2D 2-3D 69 ttl R*8 (202) VAR COMMON 7 4040 2-2D 2-3D tts R*8 (202) VAR COMMON 7 2424 2-2D 2-3D xs R*8 (487) VAR COMMON 9 32 3-2D 3-3D z R*8 (202) VAR ARG 1D 43D 69= 72 LABELS LabNo LinNo LabNo LinNo LabNo LinNo LabNo LinNo LabNo LinNo LabNo LinNo LabNo LinNo LabNo LinNo 200 70 +--------------------------------------------+ | : Referenced but not modified | | = : Value modified | | A : Actual argument, possibly modified | | D : Declared/Defined | | I : Data Initialization | | (n) : Number of occurrences | | # : Unknown usage | +--------------------------------------------+