/[MITgcm]/MITgcm/pkg/fizhi/fizhi_wrapper.F
ViewVC logotype

Diff of /MITgcm/pkg/fizhi/fizhi_wrapper.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.10 by molod, Wed Jun 16 19:19:49 2004 UTC revision 1.20 by molod, Thu Oct 7 00:06:09 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "FIZHI_OPTIONS.h"
5         subroutine fizhi_wrapper (myTime, myIter, myThid)         subroutine fizhi_wrapper (myTime, myIter, myThid)
6  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
7  c  Subroutine fizhi_wrapper - 'Wrapper' routine to interface  c  Subroutine fizhi_wrapper - 'Wrapper' routine to interface
# Line 41  c pe on dynamics and physics grid refers Line 41  c pe on dynamics and physics grid refers
41    
42         integer i, j, L, Lbotij, bi, bj         integer i, j, L, Lbotij, bi, bj
43         integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2         integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
44           _RL tempij(sNx,sNy)
45    
46         idim1 = 1-OLx         idim1 = 1-OLx
47         idim2 = sNx+OLx         idim2 = sNx+OLx
# Line 59  C  Note: Need one array to send to fizhi Line 60  C  Note: Need one array to send to fizhi
60  C        For the interpolations between physics and dynamics (bottom-up)  C        For the interpolations between physics and dynamics (bottom-up)
61          do j = 1,sNy          do j = 1,sNy
62          do i = 1,sNx          do i = 1,sNx
63           pephy(i,j,1,bi,bj)=(Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj))/           pephy(i,j,1,bi,bj)=(Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj))
      .                       rstarExpC(i,j,bi,bj)  
64           do L = 2,Nrphys+1           do L = 2,Nrphys+1
65            pephy(i,j,L,bi,bj)=pephy(i,j,L-1,bi,bj)-dpphys(i,j,L-1,bi,bj)            pephy(i,j,L,bi,bj)=pephy(i,j,L-1,bi,bj)-dpphys(i,j,L-1,bi,bj)
66           enddo           enddo
# Line 84  C Build pressures on dynamics grid Line 84  C Build pressures on dynamics grid
84          do i = 1,sNx          do i = 1,sNx
85           Lbotij = ksurfC(i,j,bi,bj)           Lbotij = ksurfC(i,j,bi,bj)
86           if(Lbotij.ne.0.)           if(Lbotij.ne.0.)
87       . pedyn(i,j,Lbotij,bi,bj) = (Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj))/       . pedyn(i,j,Lbotij,bi,bj) = (Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj))
      .                         rstarExpC(i,j,bi,bj)  
88          enddo          enddo
89          enddo          enddo
90          do j = 1,sNy          do j = 1,sNy
# Line 110  c Do not use a zero field as the top edg Line 109  c Do not use a zero field as the top edg
109       .        surftype,tilefrac,fracland)       .        surftype,tilefrac,fracland)
110  c  c
111  c Compute physics increments  c Compute physics increments
112          call do_fizhi(myThid,uphy,vphy,thphy,sphy,pephy4fiz,xC,yC,  
113       .   ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,          call do_fizhi(myThid,
114       .   tgz,sst,sice,phis_var,landtype,fracland,emiss,albnidr,albnirdf,       .  idim1,idim2,jdim1,jdim2,Nrphys,Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,
115       .   albvisdr,albvisdf,ityp,chfr,alai,agrn,igrd,chlat,chlon,       .  nchp,nchptot,nchpland,
116       .   tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,snodep,capac,       .  uphy,vphy,thphy,sphy,pephy4fiz,xC,yC,
117       .   o3,qstr,co2,cfc11,cfc12,cfc22,n2o,methane,       .  ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
118       .   idim1,idim2,jdim1,jdim2,Nrphys,Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,       .  tgz,sst,sice,phis_var,landtype,fracland,emiss,albnirdr,albnirdf,
119       .   nchp,nchpland,       .  albvisdr,albvisdf,ityp,chfr,alai,agrn,igrd,chlt,chlon,
120       .   duphy,dvphy,dthphy,dsphy)       .  tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,snodep,capac,
121         .  o3,qstr,co2,cfc11,cfc12,cfc22,n2o,methane,
122         .  iras,nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,
123         .  nswcld,cldtot_sw,cldras_sw,cldlsp_sw,nswlz,swlz,
124         .  imstturbsw,imstturblw,qliqavesw,qliqavelw,fccavesw,fccavelw,
125         .  duphy,dvphy,dthphy,dsphy)
126         enddo         enddo
127         enddo         enddo
128    
129         CALL TIMER_STOP ('DO_FIZHI          [FIZHI_WRAPPER]',mythid)         CALL TIMER_STOP ('DO_FIZHI          [FIZHI_WRAPPER]',mythid)
130    
131         CALL TIMER_START ('PHYS2DYN          [FIZHI_WRAPPER]',mythid)         CALL TIMER_START ('PHYS2DYN          [FIZHI_WRAPPER]',mythid)
# Line 132  C   into bottom-up arrays for interpolat Line 137  C   into bottom-up arrays for interpolat
137          do j = 1,sNy          do j = 1,sNy
138          do i = 1,sNx          do i = 1,sNx
139           do L = 1,Nrphys           do L = 1,Nrphys
140            tempphys(i,j,Nrphys+1-L,bi,bj)=duphy(i,j,L,bi,bj)            tempphy(i,j,Nrphys+1-L,bi,bj)=duphy(i,j,L,bi,bj)
141           enddo           enddo
142          enddo          enddo
143          enddo          enddo
144          call phys2dyn(tmpphys,pephy,idim1,idim2,jdim1,jdim2,Nrphys,          call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
145       . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,guphy)       . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,guphy)
146          do j = 1,sNy          do j = 1,sNy
147          do i = 1,sNx          do i = 1,sNx
148           do L = 1,Nrphys           do L = 1,Nrphys
149            tempphys(i,j,Nrphys+1-L,bi,bj)=dvphy(i,j,L,bi,bj)            tempphy(i,j,Nrphys+1-L,bi,bj)=dvphy(i,j,L,bi,bj)
150           enddo           enddo
151          enddo          enddo
152          enddo          enddo
153          call phys2dyn(tmpphys,pephy,idim1,idim2,jdim1,jdim2,Nrphys,          call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
154       . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gvphy)       . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gvphy)
155          do j = 1,sNy          do j = 1,sNy
156          do i = 1,sNx          do i = 1,sNx
157           do L = 1,Nrphys           do L = 1,Nrphys
158            tempphys(i,j,Nrphys+1-L,bi,bj)=dthphy(i,j,L,bi,bj)            tempphy(i,j,Nrphys+1-L,bi,bj)=dthphy(i,j,L,bi,bj)
159           enddo           enddo
160          enddo          enddo
161          enddo          enddo
162          call phys2dyn(tmpphys,pephy,idim1,idim2,jdim1,jdim2,Nrphys,          call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
163       . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gthphy)       . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gthphy)
164          do j = 1,sNy          do j = 1,sNy
165          do i = 1,sNx          do i = 1,sNx
166           do L = 1,Nrphys           do L = 1,Nrphys
167            tempphys(i,j,Nrphys+1-L,bi,bj)=dsphy(i,j,L,bi,bj)            tempphy(i,j,Nrphys+1-L,bi,bj)=dsphy(i,j,L,bi,bj)
168           enddo           enddo
169          enddo          enddo
170          enddo          enddo
171          call phys2dyn(tmpphys,pephy,idim1,idim2,jdim1,jdim2,Nrphys,          call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
172       . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gsphy)       . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gsphy)
173    
174    
175            if( (2.eq.1) ) then
176            print *,' In fizhi wrapper after phys2dyn before exchange ',bi
177            do L = 1,Nr
178             do j = 1,sNy
179             do i = 1,sNx
180              tempij(i,j) = guphy(i,j,L,bi,bj)
181             enddo
182             enddo
183    c        print *,' guphy at level ',l,' ',tempij
184            enddo
185            do L = 1,Nr
186             do j = 1,sNy
187             do i = 1,sNx
188              tempij(i,j) = gvphy(i,j,L,bi,bj)
189             enddo
190             enddo
191    c        print *,' gvphy at level ',l,' ',tempij
192            enddo
193            do L = 1,Nr
194             do j = 1,sNy
195             do i = 1,sNx
196              tempij(i,j) = gthphy(i,j,L,bi,bj)
197             enddo
198             enddo
199             print *,' gthphy at level ',l,' ',tempij
200            enddo
201            do L = 1,Nr
202             do j = 1,sNy
203             do i = 1,sNx
204              tempij(i,j) = gsphy(i,j,L,bi,bj)
205             enddo
206             enddo
207    c        print *,' gsphy at level ',l,' ',tempij
208            enddo
209            endif
210         enddo         enddo
211         enddo         enddo
212    
213         CALL TIMER_STOP ('PHYS2DYN          [FIZHI_WRAPPER]',mythid)         CALL TIMER_STOP ('PHYS2DYN          [FIZHI_WRAPPER]',mythid)
214    
215  c Convert guphy and gvphy from A-grid to C-grid for use by dynamics  c Convert guphy and gvphy from A-grid to C-grid for use by dynamics
# Line 186  c Call the a-grid exchange routine to fi Line 228  c Call the a-grid exchange routine to fi
228       .            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )       .            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
229         CALL TIMER_STOP ('EXCHANGES         [FIZHI_WRAPPER]',mythid)         CALL TIMER_STOP ('EXCHANGES         [FIZHI_WRAPPER]',mythid)
230    
231           do bj = myByLo(myThid), myByHi(myThid)
232           do bi = myBxLo(myThid), myBxHi(myThid)
233            if( (2.eq.1) ) then
234            print *,' In fizhi wrapper after exchange ',bi
235            do L = 1,Nr
236             do j = 1,sNy
237             do i = 1,sNx
238              tempij(i,j) = guphy(i,j,L,bi,bj)
239             enddo
240             enddo
241             print *,' guphy at level ',l,' ',tempij
242            enddo
243            do L = 1,Nr
244             do j = 1,sNy
245             do i = 1,sNx
246              tempij(i,j) = gvphy(i,j,L,bi,bj)
247             enddo
248             enddo
249             print *,' gvphy at level ',l,' ',tempij
250            enddo
251            do L = 1,Nr
252             do j = 1,sNy
253             do i = 1,sNx
254              tempij(i,j) = gthphy(i,j,L,bi,bj)
255             enddo
256             enddo
257             print *,' gthphy at level ',l,' ',tempij
258            enddo
259            do L = 1,Nr
260             do j = 1,sNy
261             do i = 1,sNx
262              tempij(i,j) = gsphy(i,j,L,bi,bj)
263             enddo
264             enddo
265             print *,' gsphy at level ',l,' ',tempij
266            enddo
267            endif
268           enddo
269           enddo
270    
271        return        return
272        end        end
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22