| 1 |
|
| 2 |
#include "ctrparam.h" |
| 3 |
|
| 4 |
SUBROUTINE RADIA0 (IM,JM,CO2,READGHG) 4501. |
| 5 |
C**** 4502. |
| 6 |
C**** THIS SUBROUTINE SETS THE RADIATION CONTROL PARAMETERS AND 4503. |
| 7 |
C**** CALCULATES AREA WEIGHTED LATITUDES FOR A STANDARD GRID ETC 4504. |
| 8 |
C**** 4505. |
| 9 |
|
| 10 |
#include "chem_para" |
| 11 |
#include "chem_com" |
| 12 |
|
| 13 |
REAL LT1,LT2 4506. |
| 14 |
DIMENSION COSZ(IM,JM),COSZA(IM,JM) 4507. |
| 15 |
DIMENSION SINJ(46),COSJ(46),RI(72),SINI(72),COSI(72) 4508. |
| 16 |
COMMON/WORK5/LT1(72),LT2(72),SLT1(72),SLT2(72),S2LT1(72),S2LT2(72)4509. |
| 17 |
* ,DEGLAT(46),DEGLON(72) 4510. |
| 18 |
COMMON/SCJL/SINJ,COSJ |
| 19 |
COMMON/CO2TRND/ALFFOR,CO2TR,YEARGT,CO2IN,INYRAD |
| 20 |
C 4511. |
| 21 |
C RADCOM: CONTROL/INPUT PARAMETERS 4512. |
| 22 |
C 4513. |
| 23 |
COMMON/RADCOM/VADATA(11,4,3),DGLAT(46),DGLON(72),TMINSR,FULGAS(18)4514. |
| 24 |
A ,FRACSL,RATQSL,FOGTSL,PTLISO,TLGRAD,TKCICE,FGOLDU(18)4514.5 |
| 25 |
B ,FLONO3,FRAYLE,FCLDTR,FCLDSR,FALGAE,FMARCL,FEMTRA(6) 4515. |
| 26 |
C ,WETTRA,WETSRA,DMOICE,DMLICE,LICETK,NTRCE,FZASRA(6) 4515.5 |
| 27 |
D ,ID5(5),ITR(4),IMG(2),ILG(2),LAPGAS,KWVCON,NORMS0,NV 4516. |
| 28 |
E ,KEEPRH,KEEPAL,ISOSCT,IHGSCT,KFRACC,KGASSR,KAERSR 4516.5 |
| 29 |
F ,MARCLD,LAYTOP,LMR,LMRP,JMLAT,IMLON,KFORCE,LASTVC 4517. |
| 30 |
C 4517.5 |
| 31 |
C BASIC RADCOM INPUT DATA 4518. |
| 32 |
C 4518.5 |
| 33 |
G ,PLE(40),HLB(40),TLB(40),TLT(40),TL(40),U0GAS(40,9) 4519. |
| 34 |
H ,ULGAS(40,9),TRACER(40,4),RTAU(40),QL(40),RHL(40) 4519.5 |
| 35 |
I ,POCEAN,PEARTH,POICE,PLICE,AGESN,SNOWE,SNOWOI,SNOWLI 4520. |
| 36 |
J ,TGO,TGE,TGOI,TGLI,TS,WS,WEARTH,ZOICE,FSPARE(200) 4520.5 |
| 37 |
K ,S0,COSZN,PVT(11),BXA(153),SRBXAL(15,2),FRC(5),LUXGAS4520.6 |
| 38 |
L ,JYEAR,JDAY,JLAT,ILON,MEANAL,KALVIS,ISPARE(25),SGPS 4520.8 |
| 39 |
C 5033. |
| 40 |
C BASIC RADCOM OUTPUT DATA 5034. |
| 41 |
C 5035. |
| 42 |
c M ,TRDFLB(40),TRUFLB(40),TRNFLB(40),TRFCRL(40),TRSLCR 5036. |
| 43 |
c N ,SRDFLB(40),SRUFLB(40),SRNFLB(40),SRFHRL(40),SRSLHR 5037. |
| 44 |
c O ,SRIVIS,SROVIS,PLAVIS,SRINIR,SRONIR,PLANIR,SRXATM(4) 5038. |
| 45 |
c P ,SRDVIS,SRUVIS,ALBVIS,SRDNIR,SRUNIR,ALBNIR,FSRNFG(4) 5039. |
| 46 |
c Q ,SRTVIS,SRRVIS,SRAVIS,SRTNIR,SRRNIR,SRANIR,FTRUFG(4) 5040. |
| 47 |
c R ,TRDFGW,TRUFGW,TRUFTW,BTEMPW,TRDFSL,TRUFSL,DTRUFG(4) 5041. |
| 48 |
c S ,TRSLTS,TRSLTG,TRSLWV,TRSLBS,TTRUFG,LBOTCL,LTOPCL 5042. |
| 49 |
! DATA TWOPI/6.283185/,ZERO1/1.E-5/,ZERO2/5.E-3/ 4521. |
| 50 |
! 03/07/06 |
| 51 |
DATA TWOPI/6.283185/,ZERO1/1.E-2/,ZERO2/5.E-3/ 4521. |
| 52 |
C**** COMPUTE THE AREA WEIGHTED LATITUDES AND THEIR SINES AND COSINES 4522. |
| 53 |
JMM1=JM-1 4523. |
| 54 |
PHIS=-.25*TWOPI 4524. |
| 55 |
SPHIS=-1. 4525. |
| 56 |
CPHIS=0. 4526. |
| 57 |
DO 20 J=1,JMM1 4527. |
| 58 |
PHIN=(TWOPI/(JMM1+JMM1))*(J-.5*JM) 4528. |
| 59 |
SPHIN=SIN(PHIN) 4529. |
| 60 |
CPHIN=COS(PHIN) 4530. |
| 61 |
PHIM=(PHIN*SPHIN+CPHIN-PHIS*SPHIS-CPHIS)/(SPHIN-SPHIS) 4531. |
| 62 |
DEGLAT(J)=(360./TWOPI)*PHIM 4532. |
| 63 |
SINJ(J)=SIN(PHIM) 4533. |
| 64 |
COSJ(J)=COS(PHIM) 4534. |
| 65 |
PHIS=PHIN 4535. |
| 66 |
SPHIS=SPHIN 4536. |
| 67 |
20 CPHIS=CPHIN 4537. |
| 68 |
PHIN=.25*TWOPI 4538. |
| 69 |
SPHIN=1. 4539. |
| 70 |
CPHIN=0. 4540. |
| 71 |
PHIM=(PHIN*SPHIN+CPHIN-PHIS*SPHIS-CPHIS)/(SPHIN-SPHIS) 4541. |
| 72 |
DEGLAT(JM)=(360./TWOPI)*PHIM 4542. |
| 73 |
SINJ(JM)=SIN(PHIM) 4543. |
| 74 |
COSJ(JM)=COS(PHIM) 4544. |
| 75 |
C**** COMPUTE THE SINES AND COSINES OF LONGITUDE 4545. |
| 76 |
DO 40 I=1,IM 4546. |
| 77 |
RI(I)=(TWOPI/IM)*(I-1) 4547. |
| 78 |
DEGLON(I)=(360./IM)*(I-1) 4548. |
| 79 |
SINI(I)=SIN(RI(I)) 4549. |
| 80 |
40 COSI(I)=COS(RI(I)) 4550. |
| 81 |
C**** MODIFY AND PRINT OUT THE RADIATION CONTROL PARAMETERS 4552. |
| 82 |
IF (CO2.GT.0.) FULGAS(2)=CO2 4553.1 |
| 83 |
DMOICE=10. 4553.11 |
| 84 |
C Convert masking depth over land and ocean ice to meters of water |
| 85 |
c DMOICE=0.01 |
| 86 |
c DMLICE=0.01 |
| 87 |
C Convert masking depth over land and ocean ice to meters of water |
| 88 |
C FOR THE 'REAL' TRANSIENT EXPERIMENT USE CO2=-FLOAT(KTREND)-AVGAER 4553.15 |
| 89 |
C TO USE THE DEFAULTS EXCEPT FOR CO2 SET CO2.GT.0. 4553.2 |
| 90 |
KTREND=-CO2 4553.25 |
| 91 |
print *,' KTREND=',KTREND |
| 92 |
|
| 93 |
#ifdef PREDICTED_GASES |
| 94 |
LAPGAS=0 |
| 95 |
IMG(2)=9 |
| 96 |
print *,' RADIA0 Chem ',1,READGHG,LAPGAS |
| 97 |
#endif |
| 98 |
|
| 99 |
IF (CO2.GT.0.) GO TO 50 4553.3 |
| 100 |
NTRCE=1 4553.35 |
| 101 |
ITR(1)=1 4553.4 |
| 102 |
IF (KTREND.EQ.0) KFORCE=26789 4553.45 |
| 103 |
FGOLDU(6)=1. 4553.5 |
| 104 |
LAPGAS=2 4553.55 |
| 105 |
C FULGAS(8)=0. 4553.6 |
| 106 |
C FULGAS(9)=0. 4553.65 |
| 107 |
C FGOLDU(1)=.005/.012 4553.7 |
| 108 |
c 50 CALL RCOMP1 (21,0,60) 4553.75 |
| 109 |
50 continue |
| 110 |
print *,' RADIA0 JYEAR=',JYEAR,' JDAY=',JDAY |
| 111 |
c IF (KTREND.GT.0) CALL FORSET(1958.,KTREND,1) 4553.8 |
| 112 |
IF (KTREND.GT.0)then |
| 113 |
TNOW=JYEAR+(JDAY-.5)/365. |
| 114 |
if(KTREND.GT.20) TNOW=1765. |
| 115 |
print *,' RADIA0 JYEAR=',JYEAR,' JDAY=',JDAY |
| 116 |
if (KTREND.EQ.5)then |
| 117 |
! print *,' TNOW=',TNOW |
| 118 |
print *,' TREF=',TNOW |
| 119 |
CALL FORSET(TNOW,KTREND,1) |
| 120 |
else |
| 121 |
! 04/18/2006 |
| 122 |
print *,' TREF=',YEARGT |
| 123 |
CALL FORSET(YEARGT,KTREND,1) |
| 124 |
endif |
| 125 |
endif |
| 126 |
c 06/20/2005 |
| 127 |
c CALL RCOMP1 (521,0,60) |
| 128 |
print *,'Before CALL RCOMP1' |
| 129 |
CALL RCOMP1 (521,0,60,KTREND) |
| 130 |
print *,'After CALL RCOMP1' |
| 131 |
c if(READGHG.lt.0.5) CALL WRITER (1,0) 4554. |
| 132 |
RETURN 4555. |
| 133 |
C**** 4556. |
| 134 |
C**** 4557. |
| 135 |
ENTRY COSZT (IM,JM,SIND,COSD,ROT1,ROT2,COSZ) 4558. |
| 136 |
C**** 4559. |
| 137 |
C**** THIS ENTRY COMPUTES THE ZENITH ANGLE WEIGHTED BY DAYTIME 4560. |
| 138 |
C**** HOURS FROM ROT1 TO ROT2, GREENWICH MEAN TIME IN RADIANS. ROT1 4561. |
| 139 |
C**** MUST BE BETWEEN 0 AND 2*PI. ROT2 MUST BE BETWEEN ROT1 AND 4562. |
| 140 |
C**** ROT1+2*PI. I=1 MUST LIE ON THE INTERNATIONAL DATE LINE. 4563. |
| 141 |
C**** 4564. |
| 142 |
DROT=ROT2-ROT1 4565. |
| 143 |
C**** COMPUTE THE SINES AND COSINES OF THE INITIAL AND FINAL GMT'S 4566. |
| 144 |
100 SR1=SIN(ROT1) 4567. |
| 145 |
CR1=COS(ROT1) 4568. |
| 146 |
SR2=SIN(ROT2) 4569. |
| 147 |
CR2=COS(ROT2) 4570. |
| 148 |
C**** COMPUTE THE INITIAL AND FINAL LOCAL TIMES (MEASURED FROM NOON TO 4571. |
| 149 |
C**** NOON) AND THEIR SINES AND COSINES 4572. |
| 150 |
DO 120 I=1,IM 4573. |
| 151 |
LT1(I)=ROT1+RI(I) 4574. |
| 152 |
SLT1(I)=SR1*COSI(I)+CR1*SINI(I) 4575. |
| 153 |
LT2(I)=ROT2+RI(I) 4576. |
| 154 |
120 SLT2(I)=SR2*COSI(I)+CR2*SINI(I) 4577. |
| 155 |
C**** 4578. |
| 156 |
C**** CALCULATION FOR POLAR GRID BOXES 4579. |
| 157 |
C**** 4580. |
| 158 |
DO 200 J=1,JM,JMM1 4581. |
| 159 |
SJSD=SINJ(J)*SIND 4582. |
| 160 |
CJCD=COSJ(J)*COSD 4583. |
| 161 |
IF(SJSD+CJCD.LE.ZERO1) GO TO 180 4584. |
| 162 |
IF(SJSD-CJCD.GE.0.) GO TO 160 4585. |
| 163 |
C**** AVERAGE COSZ FROM DAWN TO DUSK NEAR THE POLES 4586. |
| 164 |
DUSK=ACOS(-SJSD/CJCD) 4587. |
| 165 |
SDUSK=SQRT(CJCD*CJCD-SJSD*SJSD)/CJCD 4588. |
| 166 |
DAWN=-DUSK 4589. |
| 167 |
SDAWN=-SDUSK 4590. |
| 168 |
COSZ(1,J)=(SJSD*(DUSK-DAWN)+CJCD*(SDUSK-SDAWN))/TWOPI 4591. |
| 169 |
GO TO 200 4592. |
| 170 |
C**** CONSTANT DAYLIGHT NEAR THE POLES 4593. |
| 171 |
160 COSZ(1,J)=SJSD 4594. |
| 172 |
GO TO 200 4595. |
| 173 |
C**** CONSTANT NIGHTIME NEAR THE POLES 4596. |
| 174 |
180 COSZ(1,J)=0. 4597. |
| 175 |
200 CONTINUE 4598. |
| 176 |
C**** 4599. |
| 177 |
C**** LOOP OVER NON-POLAR LATITUDES 4600. |
| 178 |
C**** 4601. |
| 179 |
DO 500 J=2,JMM1 4602. |
| 180 |
SJSD=SINJ(J)*SIND 4603. |
| 181 |
CJCD=COSJ(J)*COSD 4604. |
| 182 |
IF(SJSD+CJCD.LE.ZERO1) GO TO 460 4605. |
| 183 |
IF(SJSD-CJCD.GE.0.) GO TO 420 4606. |
| 184 |
C**** COMPUTE DAWN AND DUSK (AT LOCAL TIME) AND THEIR SINES 4607. |
| 185 |
DUSK=ACOS(-SJSD/CJCD) 4608. |
| 186 |
SDUSK=SQRT(CJCD*CJCD-SJSD*SJSD)/CJCD 4609. |
| 187 |
DAWN=-DUSK 4610. |
| 188 |
SDAWN=-SDUSK 4611. |
| 189 |
C**** NEITHER CONSTANT DAYTIME NOR CONSTANT NIGHTIME AT THIS LATITUDE, 4612. |
| 190 |
C**** LOOP OVER LONGITUDES 4613. |
| 191 |
! 03/07/06 solar radiation |
| 192 |
ZERO2=ZERO1/CJCD |
| 193 |
DO 400 I=1,IM 4614. |
| 194 |
C**** FORCE DUSK TO LIE BETWEEN LT1 AND LT1+2*PI 4615. |
| 195 |
IF(DUSK.GT.LT1(I)+ZERO2) GO TO 220 4616. |
| 196 |
DUSK=DUSK+TWOPI 4617. |
| 197 |
DAWN=DAWN+TWOPI 4618. |
| 198 |
220 IF(DAWN.LT.LT2(I)-ZERO2) GO TO 240 4619. |
| 199 |
C**** CONTINUOUS NIGHTIME FROM INITIAL TO FINAL TIME 4620. |
| 200 |
COSZ(I,J)=0. 4621. |
| 201 |
GO TO 400 4622. |
| 202 |
240 IF(DAWN.GE.LT1(I)) GO TO 300 4623. |
| 203 |
IF(DUSK.LT.LT2(I)) GO TO 260 4624. |
| 204 |
C**** CONTINUOUS DAYLIGHT FROM INITIAL TIME TO FINAL TIME 4625. |
| 205 |
COSZ(I,J)=SJSD+CJCD*(SLT2(I)-SLT1(I))/DROT 4626. |
| 206 |
GO TO 400 4627. |
| 207 |
260 IF(DAWN+TWOPI.LT.LT2(I)-ZERO2) GO TO 280 4628. |
| 208 |
C**** DAYLIGHT AT INITIAL TIME AND NIGHT AT FINAL TIME 4629. |
| 209 |
COSZ(I,J)=(SJSD*(DUSK-LT1(I))+CJCD*(SDUSK-SLT1(I)))/DROT 4630. |
| 210 |
GO TO 400 4631. |
| 211 |
C**** DAYLIGHT AT INITIAL AND FINAL TIMES WITH NIGHTIME IN BETWEEN 4632. |
| 212 |
280 COSZ(I,J)=(SJSD*(LT2(I)-DAWN-TWOPI+DUSK-LT1(I))+CJCD* 4633. |
| 213 |
* (SLT2(I)-SDAWN+SDUSK-SLT1(I)))/DROT 4634. |
| 214 |
GO TO 400 4635. |
| 215 |
300 IF(DUSK.LT.LT2(I)) GO TO 320 4636. |
| 216 |
C**** NIGHT AT INITIAL TIME AND DAYLIGHT AT FINAL TIME 4637. |
| 217 |
COSZ(I,J)=(SJSD*(LT2(I)-DAWN)+CJCD*(SLT2(I)-SDAWN))/DROT 4638. |
| 218 |
GO TO 400 4639. |
| 219 |
C**** NIGHTIME AT INITIAL AND FINAL TIMES WITH DAYLIGHT IN BETWEEN 4640. |
| 220 |
320 COSZ(I,J)=(SJSD*(DUSK-DAWN)+CJCD*(SDUSK-SDAWN))/DROT 4641. |
| 221 |
400 CONTINUE 4642. |
| 222 |
GO TO 500 4643. |
| 223 |
C**** CONSTANT DAYLIGHT AT THIS LATITUDE 4644. |
| 224 |
420 DO 440 I=1,IM 4645. |
| 225 |
440 COSZ(I,J)=SJSD+CJCD*(SLT2(I)-SLT1(I))/DROT 4646. |
| 226 |
GO TO 500 4647. |
| 227 |
C**** CONSTANT NIGHTIME AT THIS LATITUDE 4648. |
| 228 |
460 DO 480 I=1,IM 4649. |
| 229 |
480 COSZ(I,J)=0. 4650. |
| 230 |
500 CONTINUE 4651. |
| 231 |
RETURN 4652. |
| 232 |
C**** 4653. |
| 233 |
C**** 4654. |
| 234 |
ENTRY COSZS (IM,JM,SIND,COSD,ROT1,ROT2,COSZ,COSZA) 4655. |
| 235 |
C**** 4656. |
| 236 |
C**** THIS ENTRY COMPUTES THE ZENITH ANGLE TWICE, FIRST WEIGHTED BY THE 4657. |
| 237 |
C**** DAYTIME HOURS FROM ROT1 TO ROT2 AND SECONDLY WEIGHTED BY THE 4658. |
| 238 |
C**** INCIDENT SUN LIGHT FROM ROT1 TO ROT2. COSZT MUST HAVE BEEN 4659. |
| 239 |
C**** CALLED JUST PREVIOUSLY. 4660. |
| 240 |
C**** 4661. |
| 241 |
DROT=ROT2-ROT1 4662. |
| 242 |
C**** COMPUTE THE SINES AND COSINES OF THE INITIAL AND FINAL GMT'S 4663. |
| 243 |
SR1=SIN(ROT1) 4664. |
| 244 |
CR1=COS(ROT1) 4665. |
| 245 |
SR2=SIN(ROT2) 4666. |
| 246 |
CR2=COS(ROT2) 4667. |
| 247 |
C**** COMPUTE THE INITIAL AND FINAL LOCAL TIMES (MEASURED FROM NOON TO 4668. |
| 248 |
C**** NOON) AND THEIR SINES AND COSINES 4669. |
| 249 |
DO 520 I=1,IM 4670. |
| 250 |
LT1(I)=ROT1+RI(I) 4671. |
| 251 |
SLT1(I)=SR1*COSI(I)+CR1*SINI(I) 4672. |
| 252 |
CLT1=CR1*COSI(I)-SR1*SINI(I) 4673. |
| 253 |
S2LT1(I)=2.*SLT1(I)*CLT1 4674. |
| 254 |
LT2(I)=ROT2+RI(I) 4675. |
| 255 |
SLT2(I)=SR2*COSI(I)+CR2*SINI(I) 4676. |
| 256 |
CLT2=CR2*COSI(I)-SR2*SINI(I) 4677. |
| 257 |
520 S2LT2(I)=2.*SLT2(I)*CLT2 4678. |
| 258 |
C**** 4679. |
| 259 |
C**** CALCULATION FOR POLAR GRID BOXES 4680. |
| 260 |
C**** 4681. |
| 261 |
DO 600 J=1,JM,JMM1 4682. |
| 262 |
SJSD=SINJ(J)*SIND 4683. |
| 263 |
CJCD=COSJ(J)*COSD 4684. |
| 264 |
IF(SJSD+CJCD.LE.ZERO1) GO TO 580 4685. |
| 265 |
IF(SJSD-CJCD.GE.0.) GO TO 560 4686. |
| 266 |
C**** AVERAGE COSZ FROM DAWN TO DUSK NEAR THE POLES 4687. |
| 267 |
CDUSK=-SJSD/CJCD 4688. |
| 268 |
DUSK=ACOS(CDUSK) 4689. |
| 269 |
SDUSK=SQRT(CJCD*CJCD-SJSD*SJSD)/CJCD 4690. |
| 270 |
S2DUSK=2.*SDUSK*CDUSK 4691. |
| 271 |
DAWN=-DUSK 4692. |
| 272 |
SDAWN=-SDUSK 4693. |
| 273 |
S2DAWN=-S2DUSK 4694. |
| 274 |
ECOSZ=SJSD*(DUSK-DAWN)+CJCD*(SDUSK-SDAWN) 4695. |
| 275 |
ECOSQZ=SJSD*ECOSZ+CJCD*(SJSD*(SDUSK-SDAWN)+ 4696. |
| 276 |
* .5*CJCD*(DUSK-DAWN+.5*(S2DUSK-S2DAWN))) 4697. |
| 277 |
COSZ(1,J)=ECOSZ/TWOPI 4698. |
| 278 |
COSZA(1,J)=ECOSQZ/ECOSZ 4699. |
| 279 |
GO TO 600 4700. |
| 280 |
C**** CONSTANT DAYLIGHT NEAR THE POLES 4701. |
| 281 |
560 ECOSZ=SJSD*TWOPI 4702. |
| 282 |
ECOSQZ=SJSD*ECOSZ+.5*CJCD*CJCD*TWOPI 4703. |
| 283 |
COSZ(1,J)=ECOSZ/TWOPI 4704. |
| 284 |
COSZA(1,J)=ECOSQZ/ECOSZ 4705. |
| 285 |
GO TO 600 4706. |
| 286 |
C**** CONSTANT NIGHTIME NEAR THE POLES 4707. |
| 287 |
580 COSZ(1,J)=0. 4708. |
| 288 |
COSZA(1,J)=0. 4709. |
| 289 |
600 CONTINUE 4710. |
| 290 |
C**** 4711. |
| 291 |
C**** LOOP OVER NON-POLAR LATITUDES 4712. |
| 292 |
C**** 4713. |
| 293 |
DO 900 J=2,JMM1 4714. |
| 294 |
SJSD=SINJ(J)*SIND 4715. |
| 295 |
CJCD=COSJ(J)*COSD 4716. |
| 296 |
IF(SJSD+CJCD.LE.ZERO1) GO TO 860 4717. |
| 297 |
IF(SJSD-CJCD.GE.0.) GO TO 820 4718. |
| 298 |
C**** COMPUTE DAWN AND DUSK (AT LOCAL TIME) AND THEIR SINES 4719. |
| 299 |
CDUSK=-SJSD/CJCD 4720. |
| 300 |
DUSK=ACOS(CDUSK) 4721. |
| 301 |
SDUSK=SQRT(CJCD*CJCD-SJSD*SJSD)/CJCD 4722. |
| 302 |
S2DUSK=2.*SDUSK*CDUSK 4723. |
| 303 |
DAWN=-DUSK 4724. |
| 304 |
SDAWN=-SDUSK 4725. |
| 305 |
S2DAWN=-S2DUSK 4726. |
| 306 |
C**** NEITHER CONSTANT DAYTIME NOR CONSTANT NIGHTIME AT THIS LATITUDE, 4727. |
| 307 |
C**** LOOP OVER LONGITUDES 4728. |
| 308 |
! 03/07/06 solar radiation |
| 309 |
ZERO2=ZERO1/CJCD |
| 310 |
DO 800 I=1,IM 4729. |
| 311 |
C**** FORCE DUSK TO LIE BETWEEN LT1 AND LT1+2*PI 4730. |
| 312 |
IF(DUSK.GT.LT1(I)+ZERO2) GO TO 620 4731. |
| 313 |
DUSK=DUSK+TWOPI 4732. |
| 314 |
DAWN=DAWN+TWOPI 4733. |
| 315 |
620 IF(DAWN.LT.LT2(I)-ZERO2) GO TO 640 4734. |
| 316 |
C**** CONTINUOUS NIGHTIME FROM INITIAL TO FINAL TIME 4735. |
| 317 |
COSZ(I,J)=0. 4736. |
| 318 |
COSZA(I,J)=0. 4737. |
| 319 |
GO TO 800 4738. |
| 320 |
640 IF(DAWN.GE.LT1(I)) GO TO 700 4739. |
| 321 |
IF(DUSK.LT.LT2(I)) GO TO 660 4740. |
| 322 |
C**** CONTINUOUS DAYLIGHT FROM INITIAL TIME TO FINAL TIME 4741. |
| 323 |
ECOSZ=SJSD*DROT+CJCD*(SLT2(I)-SLT1(I)) 4742. |
| 324 |
ECOSQZ=SJSD*ECOSZ+CJCD*(SJSD*(SLT2(I)-SLT1(I))+ 4743. |
| 325 |
* .5*CJCD*(DROT+.5*(S2LT2(I)-S2LT1(I)))) 4744. |
| 326 |
COSZ(I,J)=ECOSZ/DROT 4745. |
| 327 |
COSZA(I,J)=ECOSQZ/ECOSZ 4746. |
| 328 |
GO TO 800 4747. |
| 329 |
660 IF(DAWN+TWOPI.LT.LT2(I)-ZERO2) GO TO 680 4748. |
| 330 |
C**** DAYLIGHT AT INITIAL TIME AND NIGHT AT FINAL TIME 4749. |
| 331 |
ECOSZ=SJSD*(DUSK-LT1(I))+CJCD*(SDUSK-SLT1(I)) 4750. |
| 332 |
ECOSQZ=SJSD*ECOSZ+CJCD*(SJSD*(SDUSK-SLT1(I))+ 4751. |
| 333 |
* .5*CJCD*(DUSK-LT1(I)+.5*(S2DUSK-S2LT1(I)))) 4752. |
| 334 |
COSZ(I,J)=ECOSZ/DROT 4753. |
| 335 |
COSZA(I,J)=ECOSQZ/ECOSZ 4754. |
| 336 |
GO TO 800 4755. |
| 337 |
C**** DAYLIGHT AT INITIAL AND FINAL TIMES WITH NIGHTIME IN BETWEEN 4756. |
| 338 |
680 ECOSZ=SJSD*(DROT-DAWN-TWOPI+DUSK)+ 4757. |
| 339 |
* CJCD*(SLT2(I)-SDAWN+SDUSK-SLT1(I)) 4758. |
| 340 |
ECOSQZ=SJSD*ECOSZ+CJCD*(SJSD*(SDUSK-SLT1(I)+SLT2(I)-SDAWN)+ 4759. |
| 341 |
* .5*CJCD*(DUSK+DROT-DAWN-TWOPI+ 4760. |
| 342 |
* .5*(S2DUSK-S2LT1(I)+S2LT2(I)-S2DAWN))) 4761. |
| 343 |
COSZ(I,J)=ECOSZ/DROT 4762. |
| 344 |
COSZA(I,J)=ECOSQZ/ECOSZ 4763. |
| 345 |
GO TO 800 4764. |
| 346 |
700 IF(DUSK.LT.LT2(I)) GO TO 720 4765. |
| 347 |
C**** NIGHT AT INITIAL TIME AND DAYLIGHT AT FINAL TIME 4766. |
| 348 |
ECOSZ=SJSD*(LT2(I)-DAWN)+CJCD*(SLT2(I)-SDAWN) 4767. |
| 349 |
ECOSQZ=SJSD*ECOSZ+CJCD*(SJSD*(SLT2(I)-SDAWN)+ 4768. |
| 350 |
* .5*CJCD*(LT2(I)-DAWN+.5*(S2LT2(I)-S2DAWN))) 4769. |
| 351 |
COSZ(I,J)=ECOSZ/DROT 4770. |
| 352 |
COSZA(I,J)=ECOSQZ/ECOSZ 4771. |
| 353 |
GO TO 800 4772. |
| 354 |
C**** NIGHTIME AT INITIAL AND FINAL TIMES WITH DAYLIGHT IN BETWEEN 4773. |
| 355 |
720 ECOSZ=SJSD*(DUSK-DAWN)+CJCD*(SDUSK-SDAWN) 4774. |
| 356 |
ECOSQZ=SJSD*ECOSZ+CJCD*(SJSD*(SDUSK-SDAWN)+ 4775. |
| 357 |
* .5*CJCD*(DUSK-DAWN+.5*(S2DUSK-S2DAWN))) 4776. |
| 358 |
COSZ(I,J)=ECOSZ/DROT 4777. |
| 359 |
COSZA(I,J)=ECOSQZ/ECOSZ 4778. |
| 360 |
800 CONTINUE 4779. |
| 361 |
GO TO 900 4780. |
| 362 |
C**** CONSTANT DAYLIGHT AT THIS LATITUDE 4781. |
| 363 |
820 DO 840 I=1,IM 4782. |
| 364 |
ECOSZ=SJSD*DROT+CJCD*(SLT2(I)-SLT1(I)) 4783. |
| 365 |
ECOSQZ=SJSD*ECOSZ+CJCD*(SJSD*(SLT2(I)-SLT1(I))+ 4784. |
| 366 |
* .5*CJCD*(DROT+.5*(S2LT2(I)-S2LT1(I)))) 4785. |
| 367 |
COSZ(I,J)=ECOSZ/DROT 4786. |
| 368 |
840 COSZA(I,J)=ECOSQZ/ECOSZ 4787. |
| 369 |
GO TO 900 4788. |
| 370 |
C**** CONSTANT NIGHTIME AT THIS LATITUDE 4789. |
| 371 |
860 DO 880 I=1,IM 4790. |
| 372 |
COSZ(I,J)=0. 4791. |
| 373 |
880 COSZA(I,J)=0. 4792. |
| 374 |
900 CONTINUE 4793. |
| 375 |
RETURN 4794. |
| 376 |
END 4795. |
Parent Directory
| 
Revision Log
| 
Revision Graph