41 real(kind=fms_ast_kind_),
intent(in) :: ecc_in
42 real(kind=fms_ast_kind_),
intent(in) :: obliq_in
43 real(kind=fms_ast_kind_),
intent(in) :: per_in
46 integer,
parameter :: lkind = fms_ast_kind_
51 if (.not. module_is_initialized) &
52 call error_mesg(
'astronomy_mod',
'module has not been initialized', fatal)
59 if (ecc_in < 0.0_lkind .or. ecc_in > 0.99_lkind) &
60 call error_mesg(
'astronomy_mod',
'ecc must be between 0 and 0.99', fatal)
61 if (obliq_in < -90.0_lkind .or. real(obliq, fms_ast_kind_) > 90.0_lkind) &
62 call error_mesg(
'astronomy_mod',
'obliquity must be between -90. and 90. degrees', fatal)
63 if (per_in < 0.0_lkind .or. per_in > 360.0_lkind) &
64 call error_mesg(
'astronomy_mod',
'perihelion must be between 0.0 and 360. degrees', fatal)
70 ecc = real(ecc_in, r8_kind)
71 obliq = real(obliq_in, r8_kind)
72 per = real(per_in, r8_kind)
98 real(kind=fms_ast_kind_),
intent(out) :: ecc_out
99 real(kind=fms_ast_kind_),
intent(out) :: obliq_out
100 real(kind=fms_ast_kind_),
intent(out) :: per_out
107 if (.not. module_is_initialized) &
108 call error_mesg(
'astronomy_mod',
'module has not been initialized', fatal)
115 ecc_out = real(ecc, fms_ast_kind_)
116 obliq_out = real(obliq, fms_ast_kind_)
117 per_out = real(per, fms_ast_kind_)
143 fracday, rrsun, dt, allow_negative_cosz, &
146 real(kind=fms_ast_kind_),
dimension(:,:),
intent(in) :: lat, lon
147 real(kind=fms_ast_kind_),
intent(in) :: gmt, time_since_ae
148 real(kind=fms_ast_kind_),
dimension(:,:),
intent(out) :: cosz, fracday
149 real(kind=fms_ast_kind_),
intent(out) :: rrsun
150 real(kind=fms_ast_kind_),
intent(in),
optional :: dt
151 logical,
intent(in),
optional :: allow_negative_cosz
152 real(kind=fms_ast_kind_),
dimension(:,:),
intent(out),
optional :: half_day_out
158 real(kind=fms_ast_kind_),
dimension(size(lat,1),size(lat,2)) :: t, tt, h, aa, bb, st, stt, sh
159 real(kind=fms_ast_kind_) :: ang, dec
160 logical :: Lallow_negative
161 integer,
parameter :: lkind = fms_ast_kind_
187 if (time_since_ae < 0.0_lkind .or. time_since_ae > real(twopi, fms_ast_kind_)) &
188 call error_mesg(
'astronomy_mod',
'time_since_ae not between 0 and 2pi', fatal)
194 if (gmt < 0.0_lkind .or. gmt > real(twopi, fms_ast_kind_)) &
195 call error_mesg(
'astronomy_mod',
'gmt not between 0 and 2pi', fatal)
202 ang = angle(time_since_ae)
203 dec = declination(ang)
204 rrsun = r_inv_squared(ang)
210 aa = sin(lat)*sin(dec)
211 bb = cos(lat)*cos(dec)
217 t = gmt + lon - real(pi, fms_ast_kind_)
218 where(t >= real(pi, fms_ast_kind_)) t = t - real(twopi, fms_ast_kind_)
219 where(t < real(-pi,fms_ast_kind_)) t = t + real(twopi, fms_ast_kind_)
221 lallow_negative = .false.
222 if (
present(allow_negative_cosz))
then
223 if (allow_negative_cosz) lallow_negative = .true.
232 h = half_day(lat,dec)
234 if (
present(half_day_out) )
then
238 if (
present(dt) )
then
245 if (.not. lallow_negative)
then
250 where (t < -h .and. tt < -h) cosz = 0.0_lkind
257 where ( (tt+h) /= 0.0_lkind .and. t < -h .and. abs(tt) <= h) &
258 cosz = aa + bb*(stt + sh)/ (tt + h)
267 where (t < -h .and. h /= 0.0_lkind .and. h < tt) &
268 cosz = aa + bb*( sh + sh)/(h+h)
273 where ( abs(t) <= h .and. abs(tt) <= h) &
275 cosz = aa + bb*(stt - st)/ (tt - t)
282 where ((h-t) /= 0.0_lkind .and. abs(t) <= h .and. h < tt) &
283 cosz = aa + bb*(sh - st)/(h-t)
291 where (real(twopi, fms_ast_kind_) - h < tt .and. &
292 (tt+h-real(twopi, fms_ast_kind_)) /= 0.0_lkind .and. t <= h ) &
293 cosz = (cosz*(h - t) + (aa*(tt + h - real(twopi, fms_ast_kind_)) + bb &
294 * (stt + sh))) / ((h - t) + (tt + h - real(twopi, fms_ast_kind_)))
301 where(h < t .and. real(twopi, fms_ast_kind_) - h >= tt) &
311 where (h < t .and. real(twopi, fms_ast_kind_) - h < tt)
312 cosz = aa + bb*(stt + sh) / (tt + h - real(twopi, fms_ast_kind_))
316 cosz = aa + bb*(stt - st)/ (tt - t)
326 where (t < -h .and. tt < -h) fracday = 0.0_lkind
327 where (t < -h .and. abs(tt) <= h) fracday = (tt + h )/dt
328 where (t < -h .and. h < tt) fracday = ( h + h )/dt
329 where (abs(t) <= h .and. abs(tt) <= h) fracday = (tt - t )/dt
330 where (abs(t) <= h .and. h < tt) fracday = ( h - t )/dt
331 where (h < t) fracday = 0.0_lkind
332 where (real(twopi, fms_ast_kind_) - h < tt) &
333 fracday = fracday + (tt + h - real(twopi, fms_ast_kind_))/dt
338 if (.not. lallow_negative)
then
340 cosz = aa + bb*cos(t)
347 cosz = aa + bb*cos(t)
361 if (.not. lallow_negative)
then
362 cosz = max(0.0_lkind, cosz)
385 fracday, rrsun, dt, allow_negative_cosz, &
390 real(kind=fms_ast_kind_),
dimension(:),
intent(in) :: lat, lon
391 real(kind=fms_ast_kind_),
intent(in) :: gmt, time_since_ae
392 real(kind=fms_ast_kind_),
dimension(:),
intent(out) :: cosz, fracday
393 real(kind=fms_ast_kind_),
intent(out) :: rrsun
394 real(kind=fms_ast_kind_),
intent(in),
optional :: dt
395 logical,
intent(in),
optional :: allow_negative_cosz
396 real(kind=fms_ast_kind_),
dimension(:),
intent(out),
optional :: half_day_out
402 real(kind=fms_ast_kind_),
dimension(size(lat),1) :: lat_2d, lon_2d, cosz_2d, fracday_2d, halfday_2d
417 call diurnal_solar(lat_2d, lon_2d, gmt, time_since_ae, &
418 cosz_2d, fracday_2d, rrsun, dt=dt, &
419 allow_negative_cosz=allow_negative_cosz, half_day_out=halfday_2d)
430 fracday = fracday_2d(:,1)
432 if (
present(half_day_out))
then
433 half_day_out = halfday_2d(:,1)
457 fracday, rrsun, dt, allow_negative_cosz, &
460 real(kind=fms_ast_kind_),
intent(in) :: lat, lon, gmt, time_since_ae
461 real(kind=fms_ast_kind_),
intent(out) :: cosz, fracday, rrsun
462 real(kind=fms_ast_kind_),
intent(in),
optional :: dt
463 logical,
intent(in),
optional :: allow_negative_cosz
464 real(kind=fms_ast_kind_),
intent(out),
optional :: half_day_out
470 real(kind=fms_ast_kind_),
dimension(1,1) :: lat_2d, lon_2d, cosz_2d, fracday_2d, halfday_2d
484 call diurnal_solar(lat_2d, lon_2d, gmt, time_since_ae, &
485 cosz_2d, fracday_2d, rrsun, dt=dt, &
486 allow_negative_cosz=allow_negative_cosz, half_day_out=halfday_2d)
496 fracday = fracday_2d(1,1)
498 if (
present(half_day_out))
then
499 half_day_out = halfday_2d(1,1)
525 rrsun, dt_time, allow_negative_cosz, &
530 real(kind=fms_ast_kind_),
dimension(:,:),
intent(in) :: lat, lon
531 type(time_type),
intent(in) :: time
532 real(kind=fms_ast_kind_),
dimension(:,:),
intent(out) :: cosz, fracday
533 real(kind=fms_ast_kind_),
intent(out) :: rrsun
534 type(time_type),
intent(in),
optional :: dt_time
535 logical,
intent(in),
optional :: allow_negative_cosz
536 real(kind=fms_ast_kind_),
dimension(:,:),
intent(out),
optional :: half_day_out
544 real(kind=fms_ast_kind_) :: dt
545 real(kind=fms_ast_kind_) :: gmt, time_since_ae
546 integer,
parameter :: lkind = fms_ast_kind_
553 gmt = real(universal_time(time), fms_ast_kind_)
560 time_since_ae = real(orbital_time(time), fms_ast_kind_)
567 if (
present(dt_time))
then
568 dt = real(universal_time(dt_time), fms_ast_kind_)
569 if (dt > real(pi, fms_ast_kind_))
then
570 call error_mesg(
'astronomy_mod',
'radiation time step must be no longer than 12 hrs', fatal)
572 if (dt == 0.0_lkind)
then
573 call error_mesg(
'astronomy_mod',
'radiation time step must not be an integral number of days', fatal)
581 call diurnal_solar(lat, lon, gmt, time_since_ae, cosz, &
582 fracday, rrsun, dt=dt, &
583 allow_negative_cosz=allow_negative_cosz, &
584 half_day_out=half_day_out)
586 call diurnal_solar(lat, lon, gmt, time_since_ae, cosz, &
587 fracday, rrsun, allow_negative_cosz=allow_negative_cosz, &
588 half_day_out=half_day_out)
611 rrsun, dt_time, allow_negative_cosz, &
616 real(kind=fms_ast_kind_),
dimension(:),
intent(in) :: lat, lon
617 type(time_type),
intent(in) :: time
618 real(kind=fms_ast_kind_),
dimension(:),
intent(out) :: cosz, fracday
619 real(kind=fms_ast_kind_),
intent(out) :: rrsun
620 type(time_type),
intent(in),
optional :: dt_time
621 logical,
intent(in),
optional :: allow_negative_cosz
622 real(kind=fms_ast_kind_),
dimension(:),
intent(out),
optional :: half_day_out
629 real(kind=fms_ast_kind_),
dimension(size(lat),1) :: lat_2d, lon_2d, cosz_2d, &
630 fracday_2d, halfday_2d
644 if (
present(dt_time))
then
645 call diurnal_solar(lat_2d, lon_2d, time, cosz_2d, &
646 fracday_2d, rrsun, dt_time=dt_time, &
647 allow_negative_cosz=allow_negative_cosz, &
648 half_day_out=halfday_2d)
650 call diurnal_solar(lat_2d, lon_2d, time, cosz_2d, &
651 fracday_2d, rrsun, allow_negative_cosz=allow_negative_cosz, &
652 half_day_out=halfday_2d)
660 fracday = fracday_2d(:,1)
662 if (
present(half_day_out))
then
663 half_day_out = halfday_2d(:,1)
684 rrsun, dt_time, allow_negative_cosz, &
689 real(kind=fms_ast_kind_),
intent(in) :: lat, lon
690 type(time_type),
intent(in) :: time
691 real(kind=fms_ast_kind_),
intent(out) :: cosz, fracday, rrsun
692 type(time_type),
intent(in),
optional :: dt_time
693 logical,
intent(in),
optional :: allow_negative_cosz
694 real(kind=fms_ast_kind_),
intent(out),
optional :: half_day_out
702 real(kind=fms_ast_kind_),
dimension(1,1) :: lat_2d, lon_2d, cosz_2d, fracday_2d, halfday_2d
716 if (
present(dt_time))
then
717 call diurnal_solar(lat_2d, lon_2d, time, cosz_2d, &
718 fracday_2d, rrsun, dt_time=dt_time, &
719 allow_negative_cosz=allow_negative_cosz, &
720 half_day_out=halfday_2d)
722 call diurnal_solar(lat_2d, lon_2d, time, cosz_2d, &
723 fracday_2d, rrsun, allow_negative_cosz=allow_negative_cosz, &
724 half_day_out=halfday_2d)
732 fracday = fracday_2d(1,1)
734 if (
present(half_day_out))
then
735 half_day_out = halfday_2d(1,1)
756 real(kind=fms_ast_kind_),
dimension(:,:),
intent(in) :: lat
757 real(kind=fms_ast_kind_),
intent(in) :: time_since_ae
758 real(kind=fms_ast_kind_),
dimension(:,:),
intent(out) :: cosz, h_out
759 real(kind=fms_ast_kind_),
intent(out) :: rr_out
766 real(kind=fms_ast_kind_),
dimension(size(lat,1),size(lat,2)) :: h
767 real(kind=fms_ast_kind_) :: ang, dec, rr
768 integer,
parameter :: lkind = fms_ast_kind_
774 if (time_since_ae < 0.0_lkind .or. time_since_ae > real(twopi, fms_ast_kind_)) &
775 call error_mesg(
'astronomy_mod',
'time_since_ae not between 0 and 2pi', fatal)
783 ang = angle(time_since_ae)
784 dec = declination(ang)
785 h = half_day(lat, dec)
786 rr = r_inv_squared(ang)
794 where (h == 0.0_lkind)
797 cosz = sin(lat)*sin(dec) + cos(lat)*cos(dec)*sin(h)/h
799 h_out = h/real(pi, fms_ast_kind_)
819 real(kind=fms_ast_kind_),
intent(in),
dimension(:) :: lat
820 real(kind=fms_ast_kind_),
intent(in) :: time_since_ae
821 real(kind=fms_ast_kind_),
intent(out),
dimension(size(lat(:))) :: cosz
822 real(kind=fms_ast_kind_),
intent(out),
dimension(size(lat(:))) :: h_out
823 real(kind=fms_ast_kind_),
intent(out) :: rr_out
831 real(kind=fms_ast_kind_),
dimension(size(lat),1) :: lat_2d, cosz_2d, hout_2d
843 call daily_mean_solar(lat_2d, time_since_ae, cosz_2d, &
870 real(kind=fms_ast_kind_),
intent(in),
dimension(:) :: lat
871 real(kind=fms_ast_kind_),
intent(in) :: time_since_ae
872 real(kind=fms_ast_kind_),
intent(out),
dimension(size(lat(:))) :: cosz, solar
880 real(kind=fms_ast_kind_),
dimension(size(lat),1) :: lat_2d, cosz_2d, hout_2d
881 real(kind=fms_ast_kind_) :: rr_out
893 call daily_mean_solar(lat_2d, time_since_ae, cosz_2d, &
901 solar = cosz_2d(:,1)*hout_2d(:,1)*rr_out
920 real(kind=fms_ast_kind_),
intent(in) :: lat, time_since_ae
921 real(kind=fms_ast_kind_),
intent(out) :: cosz, h_out, rr_out
927 real(kind=fms_ast_kind_),
dimension(1,1) :: lat_2d, cosz_2d, hout_2d
939 call daily_mean_solar(lat_2d, time_since_ae, cosz_2d, &
967 real(kind=fms_ast_kind_),
dimension(:,:),
intent(in) :: lat
968 type(time_type),
intent(in) :: time
969 real(kind=fms_ast_kind_),
dimension(:,:),
intent(out) :: cosz, fracday
970 real(kind=fms_ast_kind_),
intent(out) :: rrsun
977 real(kind=fms_ast_kind_) :: time_since_ae
978 integer,
parameter :: lkind = fms_ast_kind_
984 time_since_ae = real(orbital_time(time), fms_ast_kind_)
985 if (time_since_ae < 0.0_lkind .or. time_since_ae > real(twopi, fms_ast_kind_)) &
986 call error_mesg(
'astronomy_mod',
'time_since_ae not between 0 and 2pi', fatal)
992 call daily_mean_solar(lat, time_since_ae, cosz, fracday, rrsun)
1009 real(kind=fms_ast_kind_),
dimension(:),
intent(in) :: lat
1010 type(time_type),
intent(in) :: time
1011 real(kind=fms_ast_kind_),
dimension(:),
intent(out) :: cosz, fracday
1012 real(kind=fms_ast_kind_),
intent(out) :: rrsun
1018 real(kind=fms_ast_kind_),
dimension(size(lat),1) :: lat_2d, cosz_2d, fracday_2d
1031 call daily_mean_solar(lat_2d, time, cosz_2d, fracday_2d, rrsun)
1038 fracday = fracday_2d(:,1)
1056 real(kind=fms_ast_kind_),
dimension(:),
intent(in) :: lat
1057 type(time_type),
intent(in) :: time
1058 real(kind=fms_ast_kind_),
dimension(:),
intent(out) :: cosz, solar
1063 real(kind=fms_ast_kind_),
dimension(size(lat),1) :: lat_2d, cosz_2d, fracday_2d
1064 real(kind=fms_ast_kind_) :: rrsun
1078 call daily_mean_solar(lat_2d, time, cosz_2d, fracday_2d, rrsun)
1085 solar = cosz_2d(:,1)*fracday_2d(:,1)*rrsun
1103 real(kind=fms_ast_kind_),
intent(in) :: lat
1104 type(time_type),
intent(in) :: time
1105 real(kind=fms_ast_kind_),
intent(out) :: cosz, fracday, rrsun
1112 real(kind=fms_ast_kind_),
dimension(1,1) :: lat_2d, cosz_2d, fracday_2d
1125 call daily_mean_solar(lat_2d, time, cosz_2d, fracday_2d, rrsun)
1132 fracday = fracday_2d(1,1)
1154 integer,
intent(in) :: js, je
1155 real(kind=fms_ast_kind_),
dimension(:,:),
intent(in) :: lat
1156 real(kind=fms_ast_kind_),
dimension(:,:),
intent(out) :: solar, cosz, fracday
1157 real(kind=fms_ast_kind_),
intent(out) :: rrsun
1164 real(kind=fms_ast_kind_),
dimension(size(lat,1),size(lat,2)) :: s,z
1165 real(kind=fms_ast_kind_) :: t
1167 integer,
parameter :: lkind = fms_ast_kind_
1173 if (.not. annual_mean_calculated)
then
1184 t = real((n-1), fms_ast_kind_)*real(twopi, fms_ast_kind_)/real(num_angles, fms_ast_kind_)
1185 call daily_mean_solar(lat,t, z, fracday, rrsun)
1190 solar = solar/real(num_angles, fms_ast_kind_)
1191 cosz = cosz/real(num_angles, fms_ast_kind_)
1197 where(solar .eq. 0.0_lkind)
1210 where(solar .eq. 0.0_lkind)
1213 fracday = solar/cosz
1221 if (
allocated (cosz_ann))
then
1223 cosz_ann = real(cosz, r8_kind)
1224 solar_ann = real(solar, r8_kind)
1225 fracday_ann = real(fracday, r8_kind)
1226 rrsun_ann = real(rrsun, r8_kind)
1233 num_pts = num_pts +
size(lat,1)*
size(lat,2)
1234 if ( num_pts == total_pts) annual_mean_calculated = .true.
1242 if (
allocated (cosz_ann))
then
1244 cosz = real(cosz_ann, fms_ast_kind_)
1245 solar = real(solar_ann, fms_ast_kind_)
1246 fracday = real(fracday_ann, fms_ast_kind_)
1247 rrsun = real(rrsun_ann, fms_ast_kind_)
1271 integer,
intent(in) :: jst, jnd
1272 real(kind=fms_ast_kind_),
dimension(:),
intent(in) :: lat(:)
1273 real(kind=fms_ast_kind_),
dimension(:),
intent(out) :: cosz, solar, fracday
1274 real(kind=fms_ast_kind_),
intent(out) :: rrsun_out
1281 real(kind=fms_ast_kind_),
dimension(size(lat),1) :: lat_2d, solar_2d, cosz_2d, fracday_2d
1282 real(kind=fms_ast_kind_) :: rrsun
1288 if ( .not. annual_mean_calculated)
then
1300 call annual_mean_solar(jst, jnd, lat_2d, cosz_2d, solar_2d, fracday_2d, rrsun)
1306 fracday = fracday_2d(:,1)
1308 solar = solar_2d(:,1)
1317 cosz(:) = real(cosz_ann(1,jst:jnd), fms_ast_kind_)
1318 solar(:) = real(solar_ann(1,jst:jnd), fms_ast_kind_)
1319 fracday(:) = real(fracday_ann(1,jst:jnd), fms_ast_kind_)
1320 rrsun = real(rrsun_ann, fms_ast_kind_)
1336 real(kind=fms_ast_kind_),
dimension(:),
intent(in) :: lat
1337 real(kind=fms_ast_kind_),
dimension(:),
intent(out) :: cosz
1338 real(kind=fms_ast_kind_),
dimension(:),
intent(out) :: solar
1346 real(kind=fms_ast_kind_),
dimension(size(lat),1) :: lat_2d, solar_2d, cosz_2d, fracday_2d
1348 real(kind=fms_ast_kind_) :: rrsun
1354 if ( .not. annual_mean_calculated)
then
1368 call annual_mean_solar(jst, jnd, lat_2d, cosz_2d, solar_2d, fracday_2d, rrsun)
1374 solar = solar_2d(:,1)
1383 call error_mesg(
'astronomy_mod',
'annual_mean_solar_2level should be called only once', fatal)
1385 annual_mean_calculated = .true.
1403 real(kind=fms_ast_kind_),
intent(in) :: ang
1414 real(kind=fms_ast_kind_) :: r
1415 real(kind=fms_ast_kind_) :: rad_per
1416 integer,
parameter :: lkind = fms_ast_kind_
1423 rad_per = real(per, fms_ast_kind_)*real(deg_to_rad, fms_ast_kind_)
1424 r = (1.0_lkind - real(ecc, fms_ast_kind_)**2)/(1.0_lkind &
1425 + real(ecc, fms_ast_kind_)*cos(ang - rad_per))
1439 real(kind=fms_ast_kind_),
intent(in) :: t
1446 real(kind=fms_ast_kind_) ::
angle_
1447 real(kind=fms_ast_kind_) :: norm_time
1448 real(kind=fms_ast_kind_) :: x
1452 integer,
parameter :: lkind = fms_ast_kind_
1462 norm_time = t * real(num_angles, fms_ast_kind_)/real(twopi, fms_ast_kind_)
1463 int = floor(norm_time)
1464 int = modulo(int,num_angles)
1466 x = norm_time - real(floor(norm_time), fms_ast_kind_)
1467 angle_ = (1.0_lkind - x) * real(orb_angle(int), fms_ast_kind_) &
1468 + x * real(orb_angle(int_1), fms_ast_kind_)
1480 real(kind=fms_ast_kind_),
intent(in) :: ang
1489 real(kind=fms_ast_kind_) :: rad_obliq
1490 real(kind=fms_ast_kind_) :: sin_dec
1496 rad_obliq = real(obliq, fms_ast_kind_)*real(deg_to_rad, fms_ast_kind_)
1497 sin_dec = - sin(rad_obliq)*sin(ang)
1510 real(kind=fms_ast_kind_),
dimension(:,:),
intent(in) :: latitude
1511 real(kind=fms_ast_kind_),
intent(in) :: dec
1512 real(kind=fms_ast_kind_),
dimension(size(latitude,1),size(latitude,2)) :: h
1519 real(kind=fms_ast_kind_),
dimension (size(latitude,1),size(latitude,2)):: &
1522 real(kind=fms_ast_kind_) :: tan_dec
1523 integer,
parameter :: lkind = fms_ast_kind_
1524 real(kind=fms_ast_kind_) :: eps = 1.0e-05_lkind
1538 where (latitude == 0.5_lkind*real(pi, fms_ast_kind_)) lat = latitude - eps
1539 where (latitude == -0.5_lkind*real(pi, fms_ast_kind_)) lat = latitude + eps
1546 cos_half_day = -tan(lat)*tan_dec
1547 where (cos_half_day <= -1.0_lkind) h = real(pi, fms_ast_kind_)
1548 where (cos_half_day >= 1.0_lkind) h = 0.0_lkind
1549 where (cos_half_day > -1.0_lkind .and. &
1550 cos_half_day < 1.0_lkind) h = acos(cos_half_day)
1564 real(kind=fms_ast_kind_),
intent(in) :: latitude, dec
1565 real(kind=fms_ast_kind_) :: h
1571 real(kind=fms_ast_kind_),
dimension(1,1) :: lat_2d, h_2d
1583 h_2d = half_day(lat_2d, dec)
subroutine daily_mean_solar_2d_(lat, time_since_ae, cosz, h_out, rr_out)
daily_mean_solar_2d computes the daily mean astronomical parameters for the input points at latitude ...
subroutine annual_mean_solar_2d_(js, je, lat, cosz, solar, fracday, rrsun)
annual_mean_solar_2d returns 2d fields of annual mean values of the cosine of zenith angle,...
subroutine diurnal_solar_cal_0d_(lat, lon, time, cosz, fracday, rrsun, dt_time, allow_negative_cosz, half_day_out)
diurnal_solar_cal_0d receives time_type inputs, converts them to real variables and then calls diurna...
subroutine get_orbital_parameters_(ecc_out, obliq_out, per_out)
get_orbital_parameters retrieves the orbital parameters for use by another module.
subroutine diurnal_solar_0d_(lat, lon, gmt, time_since_ae, cosz, fracday, rrsun, dt, allow_negative_cosz, half_day_out)
diurnal_solar_0d takes scalar input fields, makes them into 2d arrays dimensioned (1,...
subroutine diurnal_solar_1d_(lat, lon, gmt, time_since_ae, cosz, fracday, rrsun, dt, allow_negative_cosz, half_day_out)
diurnal_solar_1d takes 1-d input fields, adds a second dimension and calls diurnal_solar_2d....
real(kind=fms_ast_kind_) function declination_(ang)
Declination returns the solar declination angle at orbital position ang in earth's orbit.
subroutine daily_mean_solar_cal_2d_(lat, time, cosz, fracday, rrsun)
daily_mean_solar_cal_2d receives time_type inputs, converts them to real variables and then calls dai...
subroutine diurnal_solar_2d_(lat, lon, gmt, time_since_ae, cosz, fracday, rrsun, dt, allow_negative_cosz, half_day_out)
diurnal_solar_2d returns 2d fields of cosine of zenith angle, daylight fraction and earth-sun distanc...
subroutine daily_mean_solar_0d_(lat, time_since_ae, cosz, h_out, rr_out)
daily_mean_solar_1d takes 1-d input fields, adds a second dimension and calls daily_mean_solar_2d....
real(kind=fms_ast_kind_) function, dimension(size(latitude, 1), size(latitude, 2)) half_day_2d_(latitude, dec)
half_day_2d returns a 2-d array of half-day lengths at the latitudes and declination provided.
real(kind=fms_ast_kind_) function r_inv_squared_(ang)
r_inv_squared returns the inverse of the square of the earth-sun distance relative to the mean distan...
subroutine diurnal_solar_cal_1d_(lat, lon, time, cosz, fracday, rrsun, dt_time, allow_negative_cosz, half_day_out)
diurnal_solar_cal_1d receives time_type inputs, converts them to real variables and then calls diurna...
subroutine set_orbital_parameters_(ecc_in, obliq_in, per_in)
set_orbital_parameters saves the input values of eccentricity, obliquity and perihelion time as modul...
subroutine daily_mean_solar_cal_0d_(lat, time, cosz, fracday, rrsun)
daily_mean_solar_cal_0d converts scalar input fields to real, 2d variables and then calls daily_mean_...
real(kind=fms_ast_kind_) function half_day_0d_(latitude, dec)
half_day_0d takes scalar input fields, makes them into 2-d fields dimensioned (1,1),...
real(kind=fms_ast_kind_) function angle_(t)
angle determines the position within the earth's orbit at time t in the year (t = 0 at NH autumnal eq...
subroutine daily_mean_solar_2level_(lat, time_since_ae, cosz, solar)
daily_mean_solar_2level takes 1-d input fields, adds a second dimension and calls daily_mean_solar_2d...
subroutine annual_mean_solar_1d_(jst, jnd, lat, cosz, solar, fracday, rrsun_out)
annual_mean_solar_1d creates 2-d input fields from 1-d input fields and then calls annual_mean_solar_...
subroutine daily_mean_solar_cal_2level_(lat, time, cosz, solar)
daily_mean_solar_cal_2level receives 1d arrays and time_type input, converts them to real,...
subroutine annual_mean_solar_2level_(lat, cosz, solar)
annual_mean_solar_2level creates 2-d input fields from 1-d input fields and then calls annual_mean_so...
subroutine daily_mean_solar_1d_(lat, time_since_ae, cosz, h_out, rr_out)
daily_mean_solar_1d takes 1-d input fields, adds a second dimension and calls daily_mean_solar_2d....
subroutine diurnal_solar_cal_2d_(lat, lon, time, cosz, fracday, rrsun, dt_time, allow_negative_cosz, half_day_out)
diurnal_solar_cal_2d receives time_type inputs, converts them to real variables and then calls diurna...
subroutine daily_mean_solar_cal_1d_(lat, time, cosz, fracday, rrsun)
daily_mean_solar_cal_1d receives time_type inputs, converts them to real, 2d variables and then calls...