/[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.4 by molod, Tue May 4 19:27:55 2004 UTC revision 1.19 by molod, Thu Aug 5 17:06:40 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 "land_SIZE.h"  #include "EEPARAMS.h"
22  #include "fizhi_SIZE.h"  #include "SURFACE.h"
23  #include "DYNVARS.h"  #include "DYNVARS.h"
24    #include "fizhi_land_SIZE.h"
25    #include "fizhi_SIZE.h"
26  #include "fizhi_coms.h"  #include "fizhi_coms.h"
27  #include "gridalt_mapping.h"  #include "gridalt_mapping.h"
28  #include "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         .  duphy,dvphy,dthphy,dsphy)
123         enddo         enddo
124         enddo         enddo
125    
126         CALL TIMER_STOP ('DO_FIZHI          [FIZHI_WRAPPER]',mythid)         CALL TIMER_STOP ('DO_FIZHI          [FIZHI_WRAPPER]',mythid)
127    
128         CALL TIMER_START ('PHYS2DYN          [FIZHI_WRAPPER]',mythid)         CALL TIMER_START ('PHYS2DYN          [FIZHI_WRAPPER]',mythid)
129         do bj = myByLo(myThid), myByHi(myThid)         do bj = myByLo(myThid), myByHi(myThid)
130         do bi = myBxLo(myThid), myBxHi(myThid)         do bi = myBxLo(myThid), myBxHi(myThid)
131  c Interpolate (A-Grid) physics increments to dynamics grid  c Interpolate (A-Grid) physics increments to dynamics grid
132          call phys2dyn(duphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,  C   First flip the physics arrays (which are top-down)
133       .       1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,guphy)  C   into bottom-up arrays for interpolation to dynamics grid
134          call phys2dyn(dvphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,          do j = 1,sNy
135       .       1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gvphy)          do i = 1,sNx
136          call phys2dyn(dthphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,           do L = 1,Nrphys
137       .       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)
138          call phys2dyn(dsphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,           enddo
139       .       1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gsphy)          enddo
140            enddo
141            call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
142         . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,guphy)
143            do j = 1,sNy
144            do i = 1,sNx
145             do L = 1,Nrphys
146              tempphy(i,j,Nrphys+1-L,bi,bj)=dvphy(i,j,L,bi,bj)
147             enddo
148            enddo
149            enddo
150            call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
151         . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gvphy)
152            do j = 1,sNy
153            do i = 1,sNx
154             do L = 1,Nrphys
155              tempphy(i,j,Nrphys+1-L,bi,bj)=dthphy(i,j,L,bi,bj)
156             enddo
157            enddo
158            enddo
159            call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
160         . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gthphy)
161            do j = 1,sNy
162            do i = 1,sNx
163             do L = 1,Nrphys
164              tempphy(i,j,Nrphys+1-L,bi,bj)=dsphy(i,j,L,bi,bj)
165             enddo
166            enddo
167            enddo
168            call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
169         . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gsphy)
170    
171    
172            if( (2.eq.1) ) then
173            print *,' In fizhi wrapper after phys2dyn before exchange ',bi
174            do L = 1,Nr
175             do j = 1,sNy
176             do i = 1,sNx
177              tempij(i,j) = guphy(i,j,L,bi,bj)
178             enddo
179             enddo
180    c        print *,' guphy at level ',l,' ',tempij
181            enddo
182            do L = 1,Nr
183             do j = 1,sNy
184             do i = 1,sNx
185              tempij(i,j) = gvphy(i,j,L,bi,bj)
186             enddo
187             enddo
188    c        print *,' gvphy at level ',l,' ',tempij
189            enddo
190            do L = 1,Nr
191             do j = 1,sNy
192             do i = 1,sNx
193              tempij(i,j) = gthphy(i,j,L,bi,bj)
194             enddo
195             enddo
196             print *,' gthphy at level ',l,' ',tempij
197            enddo
198            do L = 1,Nr
199             do j = 1,sNy
200             do i = 1,sNx
201              tempij(i,j) = gsphy(i,j,L,bi,bj)
202             enddo
203             enddo
204    c        print *,' gsphy at level ',l,' ',tempij
205            enddo
206            endif
207         enddo         enddo
208         enddo         enddo
209    
210         CALL TIMER_STOP ('PHYS2DYN          [FIZHI_WRAPPER]',mythid)         CALL TIMER_STOP ('PHYS2DYN          [FIZHI_WRAPPER]',mythid)
211    
212  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
213         CALL TIMER_START ('ATOC              [FIZHI_WRAPPER]',mythid)         CALL TIMER_START ('ATOC              [FIZHI_WRAPPER]',mythid)
214         call AtoC(myThid,guphy,gvphy,maskC,im1,im2,jm1,jm2,Nr,         call AtoC(myThid,guphy,gvphy,maskC,idim1,idim2,jdim1,jdim2,Nr,
215       .                      Nsx,Nsy,1,sNx,1,sNy,guphy,gvphy)       .                      Nsx,Nsy,im1,im2,jm1,jm2,guphy,gvphy)
216         CALL TIMER_STOP ('ATOC              [FIZHI_WRAPPER]',mythid)         CALL TIMER_STOP ('ATOC              [FIZHI_WRAPPER]',mythid)
217    
218         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 225  c Call the a-grid exchange routine to fi
225       .            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )       .            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
226         CALL TIMER_STOP ('EXCHANGES         [FIZHI_WRAPPER]',mythid)         CALL TIMER_STOP ('EXCHANGES         [FIZHI_WRAPPER]',mythid)
227    
228           do bj = myByLo(myThid), myByHi(myThid)
229           do bi = myBxLo(myThid), myBxHi(myThid)
230            if( (2.eq.1) ) then
231            print *,' In fizhi wrapper after exchange ',bi
232            do L = 1,Nr
233             do j = 1,sNy
234             do i = 1,sNx
235              tempij(i,j) = guphy(i,j,L,bi,bj)
236             enddo
237             enddo
238             print *,' guphy at level ',l,' ',tempij
239            enddo
240            do L = 1,Nr
241             do j = 1,sNy
242             do i = 1,sNx
243              tempij(i,j) = gvphy(i,j,L,bi,bj)
244             enddo
245             enddo
246             print *,' gvphy at level ',l,' ',tempij
247            enddo
248            do L = 1,Nr
249             do j = 1,sNy
250             do i = 1,sNx
251              tempij(i,j) = gthphy(i,j,L,bi,bj)
252             enddo
253             enddo
254             print *,' gthphy at level ',l,' ',tempij
255            enddo
256            do L = 1,Nr
257             do j = 1,sNy
258             do i = 1,sNx
259              tempij(i,j) = gsphy(i,j,L,bi,bj)
260             enddo
261             enddo
262             print *,' gsphy at level ',l,' ',tempij
263            enddo
264            endif
265           enddo
266           enddo
267    
268        return        return
269        end        end
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.19
  ViewVC Help
Powered by ViewVC 1.1.22