/[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.6 by molod, Mon Jun 7 18:11:37 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 18  c--------------------------------------- Line 18  c---------------------------------------
18         implicit none         implicit none
19  #include "SIZE.h"  #include "SIZE.h"
20  #include "GRID.h"  #include "GRID.h"
21    #include "EEPARAMS.h"
22    #include "SURFACE.h"
23    #include "DYNVARS.h"
24  #include "fizhi_land_SIZE.h"  #include "fizhi_land_SIZE.h"
25  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
 #include "DYNVARS.h"  
26  #include "fizhi_coms.h"  #include "fizhi_coms.h"
27  #include "gridalt_mapping.h"  #include "gridalt_mapping.h"
28  #include "fizhi_land_coms.h"  #include "fizhi_land_coms.h"
29  #include "EEPARAMS.h"  #include "fizhi_earth_coms.h"
30  #include "SURFACE.h"  #include "fizhi_ocean_coms.h"
31    #include "fizhi_chemistry_coms.h"
32    
33         integer myTime, myIter, myThid         integer myTime, myIter, myThid
34    
35  c pe on dynamics and physics grid refers to bottom edge  c pe on dynamics and physics grid refers to bottom edge
36           _RL pephy4fiz(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nrphys+1,nSx,nSy)
37         _RL pephy(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nrphys+1,nSx,nSy)         _RL pephy(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nrphys+1,nSx,nSy)
38         _RL pedyn(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr+1,nSx,nSy)         _RL pedyn(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr+1,nSx,nSy)
39           _RL tempphy(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nrphys,nSx,nSy)
40           _RL fracland(sNx,sNy,Nsx,Nsy)
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         im1 = 1-OLx         idim1 = 1-OLx
47         im2 = sNx+OLx         idim2 = sNx+OLx
48         jm1 = 1-OLy         jdim1 = 1-OLy
49         jm2 = sNy+OLy         jdim2 = sNy+OLy
50         idim1 = 1         im1 = 1
51         idim2 = sNx         im2 = sNx
52         jdim1 = 1         jm1 = 1
53         jdim2 = sNy         jm2 = sNy
54    
55         do bj = myByLo(myThid), myByHi(myThid)         do bj = myByLo(myThid), myByHi(myThid)
56         do bi = myBxLo(myThid), myBxHi(myThid)         do bi = myBxLo(myThid), myBxHi(myThid)
57    
58  c  Construct the physics grid pressures  c Construct the physics grid pressures
59    C  Note: Need one array to send to fizhi (top-down) and another
60    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
67  c Do not use a zero field as the top edge pressure for interpolation  c Do not use a zero field as the top edge pressure for interpolation
68             do L = 1,Nrphys+1
69              pephy4fiz(i,j,Nrphys+2-L,bi,bj)=pephy(i,j,L,bi,bj)
70             enddo
71           if(pephy(i,j,Nrphys+1,bi,bj).lt.1.e-5)           if(pephy(i,j,Nrphys+1,bi,bj).lt.1.e-5)
72       .                               pephy(i,j,Nrphys+1,bi,bj) = 1.e-5       .                               pephy(i,j,Nrphys+1,bi,bj) = 1.e-5
73          enddo          enddo
# Line 73  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 95  c Do not use a zero field as the top edg Line 105  c Do not use a zero field as the top edg
105         CALL TIMER_START ('DO_FIZHI          [FIZHI_WRAPPER]',mythid)         CALL TIMER_START ('DO_FIZHI          [FIZHI_WRAPPER]',mythid)
106         do bj = myByLo(myThid), myByHi(myThid)         do bj = myByLo(myThid), myByHi(myThid)
107         do bi = myBxLo(myThid), myBxHi(myThid)         do bi = myBxLo(myThid), myBxHi(myThid)
108            call get_landfrac(im2,jm2,Nsx,Nsy,bi,bj,maxtyp,
109         .        surftype,tilefrac,fracland)
110  c  c
111  c Compute physics increments  c Compute physics increments
112          call do_fizhi(uphy,vphy,thphy,sphy,pephy,  
113       .                              ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,          call do_fizhi(myThid,
114       .                  xC,yC,       .  idim1,idim2,jdim1,jdim2,Nrphys,Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,
115       .            im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,1,sNx,1,sNy,bi,bj,nchp,       .  nchp,nchptot,nchpland,
116       .                                         duphy,dvphy,dthphy,dsphy)       .  uphy,vphy,thphy,sphy,pephy4fiz,xC,yC,
117         .  ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
118         .  tgz,sst,sice,phis_var,landtype,fracland,emiss,albnirdr,albnirdf,
119         .  albvisdr,albvisdf,ityp,chfr,alai,agrn,igrd,chlt,chlon,
120         .  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)
132         do bj = myByLo(myThid), myByHi(myThid)         do bj = myByLo(myThid), myByHi(myThid)
133         do bi = myBxLo(myThid), myBxHi(myThid)         do bi = myBxLo(myThid), myBxHi(myThid)
134  c Interpolate (A-Grid) physics increments to dynamics grid  c Interpolate (A-Grid) physics increments to dynamics grid
135          call phys2dyn(duphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,  C   First flip the physics arrays (which are top-down)
136       .       1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,guphy)  C   into bottom-up arrays for interpolation to dynamics grid
137          call phys2dyn(dvphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,          do j = 1,sNy
138       .       1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gvphy)          do i = 1,sNx
139          call phys2dyn(dthphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,           do L = 1,Nrphys
140       .       1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gthphy)            tempphy(i,j,Nrphys+1-L,bi,bj)=duphy(i,j,L,bi,bj)
141          call phys2dyn(dsphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,           enddo
142       .       1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gsphy)          enddo
143            enddo
144            call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
145         . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,guphy)
146            do j = 1,sNy
147            do i = 1,sNx
148             do L = 1,Nrphys
149              tempphy(i,j,Nrphys+1-L,bi,bj)=dvphy(i,j,L,bi,bj)
150             enddo
151            enddo
152            enddo
153            call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
154         . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gvphy)
155            do j = 1,sNy
156            do i = 1,sNx
157             do L = 1,Nrphys
158              tempphy(i,j,Nrphys+1-L,bi,bj)=dthphy(i,j,L,bi,bj)
159             enddo
160            enddo
161            enddo
162            call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
163         . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gthphy)
164            do j = 1,sNy
165            do i = 1,sNx
166             do L = 1,Nrphys
167              tempphy(i,j,Nrphys+1-L,bi,bj)=dsphy(i,j,L,bi,bj)
168             enddo
169            enddo
170            enddo
171            call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
172         . 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
216         CALL TIMER_START ('ATOC              [FIZHI_WRAPPER]',mythid)         CALL TIMER_START ('ATOC              [FIZHI_WRAPPER]',mythid)
217         call AtoC(myThid,guphy,gvphy,maskC,im1,im2,jm1,jm2,Nr,         call AtoC(myThid,guphy,gvphy,maskC,idim1,idim2,jdim1,jdim2,Nr,
218       .                      Nsx,Nsy,1,sNx,1,sNy,guphy,gvphy)       .                      Nsx,Nsy,im1,im2,jm1,jm2,guphy,gvphy)
219         CALL TIMER_STOP ('ATOC              [FIZHI_WRAPPER]',mythid)         CALL TIMER_STOP ('ATOC              [FIZHI_WRAPPER]',mythid)
220    
221         CALL TIMER_START ('EXCHANGES         [FIZHI_WRAPPER]',mythid)         CALL TIMER_START ('EXCHANGES         [FIZHI_WRAPPER]',mythid)
# Line 139  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.6  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22