23 subroutine read_tau_amf(me, master, errmsg, errflg)
26 integer,
intent(in) :: me, master
27 integer :: ncid, iernc, vid, dimid, status
30 character(len=*),
intent(out) :: errmsg
31 integer,
intent(out) :: errflg
34 iernc=nf90_open(trim(ugwp_taufile), nf90_nowrite, ncid)
37 write(errmsg,
'(*(a))')
"read_tau_amf: cannot open file_limb_tab data-file ", &
39 print *,
'cannot open ugwp-v1 tau-file=',trim(ugwp_taufile)
45 status = nf90_inq_dimid(ncid,
"lat", dimid)
48 status = nf90_inquire_dimension(ncid, dimid, len =ntau_d1y )
50 status = nf90_inq_dimid(ncid,
"days", dimid)
51 status = nf90_inquire_dimension(ncid, dimid, len =ntau_d2t )
53 if (me == master) print *, ntau_d1y, ntau_d2t,
' dimd of tau_ngw ugwp-v1 '
54 if (ntau_d2t .le. 0 .or. ntau_d1y .le. 0)
then
55 print *,
'ugwp-v1 tau-file=', trim(ugwp_taufile)
56 print *,
' ugwp-v1: ',
'ntau_d2t=',ntau_d2t,
'ntau_d2t=',ntau_d1y
60 if (.not.
allocated(ugwp_taulat))
allocate (ugwp_taulat(ntau_d1y ))
61 if (.not.
allocated(days_limb))
allocate (days_limb(ntau_d2t))
62 if (.not.
allocated(tau_limb))
allocate (tau_limb(ntau_d1y, ntau_d2t ))
64 iernc=nf90_inq_varid( ncid,
'DAYS', vid )
65 iernc= nf90_get_var( ncid, vid, days_limb)
66 iernc=nf90_inq_varid( ncid,
'LATS', vid )
67 iernc= nf90_get_var( ncid, vid, ugwp_taulat)
68 iernc=nf90_inq_varid( ncid,
'ABSMF', vid )
69 iernc= nf90_get_var( ncid, vid, tau_limb)
71 iernc=nf90_close(ncid)
78 subroutine cires_indx_ugwp (npts, me, master, dlat,j1_tau,j2_tau, w1_j1tau, w2_j2tau)
80 use machine,
only: kind_phys
84 integer,
intent(in) :: npts, me, master
85 real(kind=kind_phys) ,
dimension(npts),
intent(in) :: dlat
87 integer,
dimension(npts),
intent(inout) :: j1_tau, j2_tau
88 real(kind=kind_phys) ,
dimension(npts),
intent(inout) :: w1_j1tau, w2_j2tau
92 integer :: i,j, j1, j2
97 if (dlat(j) < ugwp_taulat(i))
then
104 j2_tau(j) = min(j2_tau(j),ntau_d1y)
105 j1_tau(j) = max(j2_tau(j)-1,1)
107 if (j1_tau(j) /= j2_tau(j) )
then
108 w2_j2tau(j) = (dlat(j) - ugwp_taulat(j1_tau(j))) &
109 / (ugwp_taulat(j2_tau(j))-ugwp_taulat(j1_tau(j)))
113 w1_j1tau(j) = 1.0 - w2_j2tau(j)
119 subroutine tau_amf_interp(me, master, im, idate, fhour, j1_tau,j2_tau, ddy_j1, ddy_j2, tau_ddd)
120 use machine,
only: kind_phys
124 integer,
intent(in) :: me, master
125 integer,
intent(in) :: im, idate(4)
126 real(kind=kind_phys),
intent(in) :: fhour
128 real(kind=kind_phys),
intent(in),
dimension(im) :: ddy_j1, ddy_j2
129 integer ,
intent(in),
dimension(im) :: j1_tau,j2_tau
131 real(kind=kind_phys),
dimension(im) :: tau_ddd
134 integer :: i, j1, j2, it1, it2 , iday
136 real(kind=kind_phys) :: tx1, tx2, w1, w2, fddd
140 call gfs_idate_calendar(idate, fhour, ddd, fddd)
144 if (fddd .lt. days_limb(iday) )
then
150 it2 = min(it2,ntau_d2t)
152 if (it2 > ntau_d2t )
then
153 print *,
' Error in time-interpolation for tau_amf_interp '
154 print *,
' it1, it2, ntau_d2t ', it1, it2, ntau_d2t
155 print *,
' Error in time-interpolation see cires_tauamf_data.F90 '
159 w2 = (fddd-days_limb(it1))/(days_limb(it2)-days_limb(it1))
165 tx1 = tau_limb(j1, it1)*ddy_j1(i)+tau_limb(j2, it1)*ddy_j2(i)
166 tx2 = tau_limb(j1, it2)*ddy_j1(i)+tau_limb(j2, it2)*ddy_j2(i)
167 tau_ddd(i) = tx1*w1 + w2*tx2
173 subroutine gfs_idate_calendar(idate, fhour, ddd, fddd)
175 use machine,
only: kind_phys
178 integer,
intent(in) :: idate(4)
179 real(kind=kind_phys),
intent(in) :: fhour
181 integer,
intent(out) :: ddd
182 real(kind=kind_phys),
intent(out) :: fddd
186 real(kind=kind_phys) :: rjday
187 integer :: jdow, jdoy, jday
194 integer idat(8),jdat(8)
205 call w3movdat(rinc, idat,jdat)
210 call w3doxdat(jdat,jdow, ddd, jday)
211 fddd = float(ddd) + jdat(5) / 24.