00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020 module ice_orbital
00021
00022
00023
00024 use ice_kinds_mod
00025 use ice_domain
00026 use ice_domain_size
00027 use ice_constants
00028 use shr_orb_mod
00029
00030
00031 use ice_diagnostics
00032
00033
00034
00035 implicit none
00036 save
00037
00038 integer (kind=int_kind) :: iyear_AD
00039
00040 real(kind=dbl_kind) :: eccen
00041 real(kind=dbl_kind) :: obliqr
00042 real(kind=dbl_kind) :: lambm0
00043
00044 real(kind=dbl_kind) :: mvelpp
00045
00046 real(kind=dbl_kind) :: obliq
00047 real(kind=dbl_kind) :: mvelp
00048 real(kind=dbl_kind) :: delta
00049 real(kind=dbl_kind) :: eccf
00050
00051 logical(kind=log_kind) :: log_print
00052
00053
00054
00055 contains
00056
00057
00058
00059
00060
00061
00062
00063
00064 subroutine init_orbit
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081 iyear_AD = 1950
00082 log_print = .false.
00083
00084 call shr_orb_params( iyear_AD , eccen , obliq , mvelp , &
00085 obliqr , lambm0 , mvelpp, log_print )
00086
00087 end subroutine init_orbit
00088
00089
00090
00091
00092
00093
00094
00095
00096 subroutine compute_coszen (nx_block, ny_block, &
00097 icells, &
00098 indxi, indxj, &
00099 tlat, tlon, &
00100 coszen, dt)
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111 use ice_calendar, only: yday, sec, secday, days_per_year, &
00112 calendar_type, nextsw_cday
00113
00114
00115
00116 integer (kind=int_kind), intent(in) ::
00117 nx_block, ny_block,
00118 icells
00119
00120 integer (kind=int_kind), dimension (nx_block*ny_block) ::
00121 indxi, indxj
00122
00123 real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in) ::
00124 tlat, tlon
00125
00126 real (kind=dbl_kind), dimension(nx_block,ny_block), intent(inout) ::
00127 coszen
00128
00129
00130 real (kind=dbl_kind), intent(in) ::
00131 dt
00132
00133
00134
00135 real (kind=dbl_kind) :: ydayp1
00136
00137 integer (kind=int_kind) ::
00138 i ,
00139 j ,
00140 ij
00141
00142
00143
00144
00145 #ifdef CCSMCOUPLED
00146 if (calendar_type == "GREGORIAN") then
00147 ydayp1 = min(nextsw_cday, real(days_per_year,kind=dbl_kind))
00148 else
00149 ydayp1 = nextsw_cday
00150 endif
00151 #else
00152 ydayp1 = yday + sec/secday
00153 #endif
00154
00155 if (ydayp1 > -0.5_dbl_kind) then
00156
00157 call shr_orb_decl(ydayp1, eccen, mvelpp, lambm0, &
00158 obliqr, delta, eccf)
00159
00160 coszen(:,:) = c0
00161
00162
00163
00164
00165 do ij = 1, icells
00166 i = indxi(ij)
00167 j = indxj(ij)
00168
00169
00170
00171
00172 coszen(i,j) = sin(tlat(i,j))*sin(delta) - &
00173 cos(tlat(i,j))*cos(delta) &
00174 *cos(ydayp1*c2*pi + tlon(i,j))
00175
00176 enddo
00177
00178 endif
00179
00180 end subroutine compute_coszen
00181
00182
00183
00184 end module ice_orbital
00185
00186