3 |
|
|
4 |
#include "FIZHI_OPTIONS.h" |
#include "FIZHI_OPTIONS.h" |
5 |
subroutine swrio (nymd,nhms,bi,bj,ndswr,myid,istrip,npcs, |
subroutine swrio (nymd,nhms,bi,bj,ndswr,myid,istrip,npcs, |
6 |
. low_level,mid_level, |
. low_level,mid_level,im,jm,lm, |
7 |
. pz,plz,plze,dpres,pkht,pkz,tz,qz,oz,co2, |
. pz,plz,plze,dpres,pkht,pkz,tz,qz,oz,co2, |
8 |
. albvisdr,albvisdf,albnirdr,albnirdf, |
. albvisdr,albvisdf,albnirdr,albnirdf, |
9 |
. dtradsw,dtswclr,radswg,swgclr, |
. dtradsw,dtswclr,radswg,swgclr, |
10 |
. fdifpar,fdirpar,osr,osrclr, |
. fdifpar,fdirpar,osr,osrclr, |
11 |
. im,jm,lm,ptop, |
. ptop,nswcld,cldsw,cswmo,nswlz,swlz, |
|
. nswcld,cldsw,cswmo,nswlz,swlz, |
|
12 |
. lpnt,imstturb,qliqave,fccave,landtype,xlats,xlons) |
. lpnt,imstturb,qliqave,fccave,landtype,xlats,xlons) |
13 |
|
|
14 |
implicit none |
implicit none |
95 |
_RL taua (istrip,lm) |
_RL taua (istrip,lm) |
96 |
_RL tstrip (istrip) |
_RL tstrip (istrip) |
97 |
|
|
98 |
|
_RL tempij(im,jm) |
99 |
|
_RL tempstrip(istrip) |
100 |
|
|
101 |
logical first |
logical first |
102 |
data first /.true./ |
data first /.true./ |
103 |
|
|
105 |
C **** INITIALIZATION **** |
C **** INITIALIZATION **** |
106 |
C ********************************************************************** |
C ********************************************************************** |
107 |
|
|
108 |
|
print *,' Just inside sw ' |
109 |
|
print *,'nymd,nhms,bi,bj,ndswr,myid,istrip,npcs ', |
110 |
|
.nymd,' ',nhms,' ',bi,' ',bj,' ',ndswr,' ',myid,' ',istrip,' ',npcs |
111 |
|
print *,'low_level,mid_level ',low_level,' ',mid_level |
112 |
|
print *,' im,jm,lm ',im,' ',jm,' ',lm,' ptop ',ptop |
113 |
|
do j = 1,jm |
114 |
|
do i = 1,im |
115 |
|
tempij(i,j) = pz(i,j) |
116 |
|
enddo |
117 |
|
enddo |
118 |
|
print *,' pz ',tempij |
119 |
|
do L = 1,lm |
120 |
|
do j = 1,jm |
121 |
|
do i = 1,im |
122 |
|
tempij(i,j) = plz(i,j,l) |
123 |
|
enddo |
124 |
|
enddo |
125 |
|
print *,' plz level ',L,' ',tempij |
126 |
|
enddo |
127 |
|
do L = 1,lm+1 |
128 |
|
do j = 1,jm |
129 |
|
do i = 1,im |
130 |
|
tempij(i,j) = plze(i,j,l) |
131 |
|
enddo |
132 |
|
enddo |
133 |
|
print *,' plze level ',L,' ',tempij |
134 |
|
enddo |
135 |
|
do L = 1,lm |
136 |
|
do j = 1,jm |
137 |
|
do i = 1,im |
138 |
|
tempij(i,j) = dpres(i,j,l) |
139 |
|
enddo |
140 |
|
enddo |
141 |
|
print *,' dpres level ',L,' ',tempij |
142 |
|
enddo |
143 |
|
do L = 1,lm+1 |
144 |
|
do j = 1,jm |
145 |
|
do i = 1,im |
146 |
|
tempij(i,j) = pkht(i,j,l) |
147 |
|
enddo |
148 |
|
enddo |
149 |
|
print *,' pkht level ',L,' ',tempij |
150 |
|
enddo |
151 |
|
do L = 1,lm |
152 |
|
do j = 1,jm |
153 |
|
do i = 1,im |
154 |
|
tempij(i,j) = pkz(i,j,l) |
155 |
|
enddo |
156 |
|
enddo |
157 |
|
print *,' pkz level ',L,' ',tempij |
158 |
|
enddo |
159 |
|
do L = 1,lm |
160 |
|
do j = 1,jm |
161 |
|
do i = 1,im |
162 |
|
tempij(i,j) = tz(i,j,l) |
163 |
|
enddo |
164 |
|
enddo |
165 |
|
print *,' tz level ',L,' ',tempij |
166 |
|
enddo |
167 |
|
do L = 1,lm |
168 |
|
do j = 1,jm |
169 |
|
do i = 1,im |
170 |
|
tempij(i,j) = qz(i,j,l) |
171 |
|
enddo |
172 |
|
enddo |
173 |
|
print *,' qz level ',L,' ',tempij |
174 |
|
enddo |
175 |
|
do L = 1,lm |
176 |
|
do j = 1,jm |
177 |
|
do i = 1,im |
178 |
|
tempij(i,j) = oz(i,j,l) |
179 |
|
enddo |
180 |
|
enddo |
181 |
|
print *,' oz level ',L,' ',tempij |
182 |
|
enddo |
183 |
|
do j = 1,jm |
184 |
|
do i = 1,im |
185 |
|
tempij(i,j) = albvisdr(i,j) |
186 |
|
enddo |
187 |
|
enddo |
188 |
|
print *,' albvisdr ',tempij |
189 |
|
do j = 1,jm |
190 |
|
do i = 1,im |
191 |
|
tempij(i,j) = albvisdf(i,j) |
192 |
|
enddo |
193 |
|
enddo |
194 |
|
print *,' albvisdf ',tempij |
195 |
|
do j = 1,jm |
196 |
|
do i = 1,im |
197 |
|
tempij(i,j) = albnirdr(i,j) |
198 |
|
enddo |
199 |
|
enddo |
200 |
|
print *,' albnirdr ',tempij |
201 |
|
do j = 1,jm |
202 |
|
do i = 1,im |
203 |
|
tempij(i,j) = albnirdf(i,j) |
204 |
|
enddo |
205 |
|
enddo |
206 |
|
print *,' albnirdf ',tempij |
207 |
|
do j = 1,jm |
208 |
|
do i = 1,im |
209 |
|
tempij(i,j) = landtype(i,j) |
210 |
|
enddo |
211 |
|
enddo |
212 |
|
print *,' landtype ',tempij |
213 |
|
do j = 1,jm |
214 |
|
do i = 1,im |
215 |
|
tempij(i,j) = xlats(i,j) |
216 |
|
enddo |
217 |
|
enddo |
218 |
|
print *,' xlats ',tempij |
219 |
|
do j = 1,jm |
220 |
|
do i = 1,im |
221 |
|
tempij(i,j) = xlons(i,j) |
222 |
|
enddo |
223 |
|
enddo |
224 |
|
print *,' xlons ',tempij |
225 |
|
|
226 |
grav = getcon('GRAVITY') |
grav = getcon('GRAVITY') |
227 |
cp = getcon('CP') |
cp = getcon('CP') |
228 |
undef = getcon('UNDEF') |
undef = getcon('UNDEF') |
599 |
enddo |
enddo |
600 |
enddo |
enddo |
601 |
|
|
602 |
|
print *,' About to call sorad ' |
603 |
|
print *,' istrip, lm, co2, mid_level,low_level ', |
604 |
|
. istrip,' ',lm,' ',co2,' ',mid_level,' ',low_level |
605 |
|
do L = 1,lm |
606 |
|
do i = 1,istrip |
607 |
|
tempstrip(i) = ple(i,l) |
608 |
|
enddo |
609 |
|
print *,' ple level ',L,' ',tempstrip |
610 |
|
enddo |
611 |
|
do L = 1,lm |
612 |
|
do i = 1,istrip |
613 |
|
tempstrip(i) = tzl(i,l) |
614 |
|
enddo |
615 |
|
print *,' tzl level ',L,' ',tempstrip |
616 |
|
enddo |
617 |
|
do L = 1,lm |
618 |
|
do i = 1,istrip |
619 |
|
tempstrip(i) = qzl(i,l) |
620 |
|
enddo |
621 |
|
print *,' qzl level ',L,' ',tempstrip |
622 |
|
enddo |
623 |
|
do L = 1,lm |
624 |
|
do i = 1,istrip |
625 |
|
tempstrip(i) = ozl(i,l) |
626 |
|
enddo |
627 |
|
print *,' ozl level ',L,' ',tempstrip |
628 |
|
enddo |
629 |
|
do L = 1,lm |
630 |
|
do i = 1,istrip |
631 |
|
tempstrip(i) = tauc(i,l,1) |
632 |
|
enddo |
633 |
|
print *,' tauc 1 level ',L,' ',tempstrip |
634 |
|
enddo |
635 |
|
do L = 1,lm |
636 |
|
do i = 1,istrip |
637 |
|
tempstrip(i) = tauc(i,l,2) |
638 |
|
enddo |
639 |
|
print *,' tauc 2 level ',L,' ',tempstrip |
640 |
|
enddo |
641 |
|
do L = 1,lm |
642 |
|
do i = 1,istrip |
643 |
|
tempstrip(i) = reff(i,l,1) |
644 |
|
enddo |
645 |
|
print *,' reff 1 level ',L,' ',tempstrip |
646 |
|
enddo |
647 |
|
do L = 1,lm |
648 |
|
do i = 1,istrip |
649 |
|
tempstrip(i) = reff(i,l,2) |
650 |
|
enddo |
651 |
|
print *,' reff 2 level ',L,' ',tempstrip |
652 |
|
enddo |
653 |
|
do L = 1,lm |
654 |
|
do i = 1,istrip |
655 |
|
tempstrip(i) = taua(i,l) |
656 |
|
enddo |
657 |
|
print *,' taua level ',L,' ',tempstrip |
658 |
|
enddo |
659 |
|
do L = 1,lm |
660 |
|
do i = 1,istrip |
661 |
|
tempstrip(i) = clro(i,l) |
662 |
|
enddo |
663 |
|
print *,' clro level ',L,' ',tempstrip |
664 |
|
enddo |
665 |
|
do i = 1,istrip |
666 |
|
tempstrip(i) = albirdr(i) |
667 |
|
enddo |
668 |
|
print *,' albirdr ',tempstrip |
669 |
|
do i = 1,istrip |
670 |
|
tempstrip(i) = albirdf(i) |
671 |
|
enddo |
672 |
|
print *,' albirdf ',tempstrip |
673 |
|
do i = 1,istrip |
674 |
|
tempstrip(i) = albuvdr(i) |
675 |
|
enddo |
676 |
|
print *,' albuvdr ',tempstrip |
677 |
|
do i = 1,istrip |
678 |
|
tempstrip(i) = albuvdf(i) |
679 |
|
enddo |
680 |
|
print *,' albuvdf ',tempstrip |
681 |
|
do i = 1,istrip |
682 |
|
tempstrip(i) = cosz(i) |
683 |
|
enddo |
684 |
|
print *,' cosz ',tempstrip |
685 |
|
|
686 |
|
stop |
687 |
|
|
688 |
call sorad ( istrip,1,1,lm,ple,tzl,qzl,ozl,co2, |
call sorad ( istrip,1,1,lm,ple,tzl,qzl,ozl,co2, |
689 |
. tauc,reff,clro,mid_level,low_level,taua, |
. tauc,reff,clro,mid_level,low_level,taua, |
690 |
. albirdr,albirdf,albuvdr,albuvdf,cosz, |
. albirdr,albirdf,albuvdr,albuvdf,cosz, |
1750 |
enddo |
enddo |
1751 |
enddo |
enddo |
1752 |
|
|
1753 |
c call cldflx (m,n,np,ict,icb,cc,rr,tt,td,rs,ts, |
call cldflx (m,n,np,ict,icb,cc,rr,tt,td,rs,ts, |
1754 |
c * fclr,fall,fsdir,fsdif) |
* fclr,fall,fsdir,fsdif) |
1755 |
|
|
1756 |
do k= 1, np+1 |
do k= 1, np+1 |
1757 |
do j= 1, n |
do j= 1, n |
2121 |
fsdif(i,j) = 0. |
fsdif(i,j) = 0. |
2122 |
enddo |
enddo |
2123 |
enddo |
enddo |
2124 |
c call cldflx (m,n,np,ict,icb,cc,rr,tt,td,rs,ts, |
call cldflx (m,n,np,ict,icb,cc,rr,tt,td,rs,ts, |
2125 |
c * fclr,fall,fsdir,fsdif) |
* fclr,fall,fsdir,fsdif) |
2126 |
|
|
2127 |
do k= 1, np+1 |
do k= 1, np+1 |
2128 |
do j= 1, n |
do j= 1, n |