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

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

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

revision 1.5 by edhill, Wed May 5 00:39:21 2004 UTC revision 1.12 by molod, Sun Aug 29 19:39:42 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "FIZHI_OPTIONS.h"
5         subroutine step_fizhi_corr (myTime, myIter, myThid)         subroutine step_fizhi_corr (myTime, myIter, myThid)
6  c----------------------------------------------------------------------  c----------------------------------------------------------------------
7  c  Subroutine step_fizhi_corr - 'Wrapper' routine to advance  c  Subroutine step_fizhi_corr - 'Wrapper' routine to advance
# Line 18  c      dyn2phys (4) (interpolate A-Grid Line 19  c      dyn2phys (4) (interpolate A-Grid
19  c      step_physics (advance physics state by correction term)  c      step_physics (advance physics state by correction term)
20  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
21         implicit none         implicit none
 #include "CPP_OPTIONS.h"  
22  #include "SIZE.h"  #include "SIZE.h"
23  #include "GRID.h"  #include "GRID.h"
24  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
25  #include "land_SIZE.h"  #include "fizhi_land_SIZE.h"
26  #include "DYNVARS.h"  #include "DYNVARS.h"
27  #include "fizhi_coms.h"  #include "fizhi_coms.h"
28  #include "gridalt_mapping.h"  #include "gridalt_mapping.h"
# Line 38  c pe on dynamics and physics grid refers Line 38  c pe on dynamics and physics grid refers
38         _RL udyntemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)         _RL udyntemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
39         _RL vdyntemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)         _RL vdyntemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
40         _RL thdyntemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)         _RL thdyntemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
41         _RL sdyntemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nrphys,nSx,nSy)         _RL sdyntemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
42         _RL uphytemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nrphys,nSx,nSy)         _RL uphytemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nrphys,nSx,nSy)
43         _RL vphytemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nrphys,nSx,nSy)         _RL vphytemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nrphys,nSx,nSy)
44         _RL thphytemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nrphys,nSx,nSy)         _RL thphytemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nrphys,nSx,nSy)
45         _RL sphytemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nrphys,nSx,nSy)         _RL sphytemp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nrphys,nSx,nSy)
46           _RL tempphy(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nrphys,nSx,nSy)
47    
48         integer i, j, L, Lbotij, bi, bj         integer i, j, L, Lbotij, bi, bj
49         integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2         integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
50         _RL dt         _RL dt
51    
52           _RL tempij(sNx,sNy)
53    
54         im1 = 1-OLx         im1 = 1-OLx
55         im2 = sNx+OLx         im2 = sNx+OLx
56         jm1 = 1-OLy         jm1 = 1-OLy
# Line 119  c Create a wind magnitude field on the p Line 122  c Create a wind magnitude field on the p
122    
123  c Compute correction term (new dyn state-phys state to dyn) on physics grid:  c Compute correction term (new dyn state-phys state to dyn) on physics grid:
124  c    First: interp physics state to dynamics grid  c    First: interp physics state to dynamics grid
125          call phys2dyn(uphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,  C Note: physics field levels are numbered top down - need bottom up
126            do L = 1,Nrphys
127            do j = 1,sNy
128            do i = 1,sNx
129             tempphy(i,j,Nrphys+1-L,bi,bj) = uphy(i,j,L,bi,bj)
130            enddo
131            enddo
132            enddo
133            call phys2dyn(tempphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,
134       .        1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,udyntemp)       .        1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,udyntemp)
135          call phys2dyn(vphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,          do L = 1,Nrphys
136            do j = 1,sNy
137            do i = 1,sNx
138             tempphy(i,j,Nrphys+1-L,bi,bj) = vphy(i,j,L,bi,bj)
139            enddo
140            enddo
141            enddo
142            call phys2dyn(tempphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,
143       .        1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,vdyntemp)       .        1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,vdyntemp)
144          call phys2dyn(thphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,          do L = 1,Nrphys
145            do j = 1,sNy
146            do i = 1,sNx
147             tempphy(i,j,Nrphys+1-L,bi,bj) = thphy(i,j,L,bi,bj)
148            enddo
149            enddo
150            enddo
151            call phys2dyn(tempphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,
152       .        1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,thdyntemp)       .        1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,thdyntemp)
153          call phys2dyn(sphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,          do L = 1,Nrphys
154            do j = 1,sNy
155            do i = 1,sNx
156             tempphy(i,j,Nrphys+1-L,bi,bj) = sphy(i,j,L,bi,bj)
157            enddo
158            enddo
159            enddo
160            call phys2dyn(tempphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,
161       .        1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,sdyntemp)       .        1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,sdyntemp)
162    
163         enddo         enddo
# Line 169  c    Fifth: Interpolate correction terms Line 201  c    Fifth: Interpolate correction terms
201         do bi = myBxLo(myThid), myBxHi(myThid)         do bi = myBxLo(myThid), myBxHi(myThid)
202    
203          call dyn2phys(udyntemp,pedyn,im1,im2,jm1,jm2,Nr,Nsx,Nsy,1,sNx,          call dyn2phys(udyntemp,pedyn,im1,im2,jm1,jm2,Nr,Nsx,Nsy,1,sNx,
204       .      1,sNy,bi,bj,windphy,pephy,ksurfC,Nrphys,nlperdyn,1,uphytemp)       .      1,sNy,bi,bj,windphy,pephy,ksurfC,Nrphys,nlperdyn,1,tempphy)
205    C Note: correction term is now bottom up - needed in top down arrays
206            do L = 1,Nrphys
207            do j = 1,sNy
208            do i = 1,sNx
209             uphytemp(i,j,Nrphys+1-L,bi,bj) = tempphy(i,j,L,bi,bj)
210            enddo
211            enddo
212            enddo
213          call dyn2phys(vdyntemp,pedyn,im1,im2,jm1,jm2,Nr,Nsx,Nsy,1,sNx,          call dyn2phys(vdyntemp,pedyn,im1,im2,jm1,jm2,Nr,Nsx,Nsy,1,sNx,
214       .      1,sNy,bi,bj,windphy,pephy,ksurfC,Nrphys,nlperdyn,1,vphytemp)       .      1,sNy,bi,bj,windphy,pephy,ksurfC,Nrphys,nlperdyn,1,tempphy)
215            do L = 1,Nrphys
216            do j = 1,sNy
217            do i = 1,sNx
218             vphytemp(i,j,Nrphys+1-L,bi,bj) = tempphy(i,j,L,bi,bj)
219            enddo
220            enddo
221            enddo
222          call dyn2phys(thdyntemp,pedyn,im1,im2,jm1,jm2,Nr,Nsx,Nsy,1,sNx,          call dyn2phys(thdyntemp,pedyn,im1,im2,jm1,jm2,Nr,Nsx,Nsy,1,sNx,
223       .     1,sNy,bi,bj,windphy,pephy,ksurfC,Nrphys,nlperdyn,0,thphytemp)       .     1,sNy,bi,bj,windphy,pephy,ksurfC,Nrphys,nlperdyn,0,tempphy)
224            do L = 1,Nrphys
225            do j = 1,sNy
226            do i = 1,sNx
227             thphytemp(i,j,Nrphys+1-L,bi,bj) = tempphy(i,j,L,bi,bj)
228            enddo
229            enddo
230            enddo
231          call dyn2phys(sdyntemp,pedyn,im1,im2,jm1,jm2,Nr,Nsx,Nsy,1,sNx,          call dyn2phys(sdyntemp,pedyn,im1,im2,jm1,jm2,Nr,Nsx,Nsy,1,sNx,
232       .      1,sNy,bi,bj,windphy,pephy,ksurfC,Nrphys,nlperdyn,0,sphytemp)       .      1,sNy,bi,bj,windphy,pephy,ksurfC,Nrphys,nlperdyn,0,tempphy)
233            do L = 1,Nrphys
234            do j = 1,sNy
235            do i = 1,sNx
236             sphytemp(i,j,Nrphys+1-L,bi,bj) = tempphy(i,j,L,bi,bj)
237            enddo
238            enddo
239            enddo
240         enddo         enddo
241         enddo         enddo
242         CALL TIMER_STOP('DYN2PHYS          [STEP_FIZHI_CORR]',mythid)         CALL TIMER_STOP('DYN2PHYS          [STEP_FIZHI_CORR]',mythid)
# Line 187  c    Last: Increment physics state by th Line 248  c    Last: Increment physics state by th
248       .   Nrphys,Nsx,Nsy,1,sNx,1,sNy,bi,bj,       .   Nrphys,Nsx,Nsy,1,sNx,1,sNy,bi,bj,
249       .                            uphytemp,vphytemp,thphytemp,sphytemp)       .                            uphytemp,vphytemp,thphytemp,sphytemp)
250    
251          if(2.eq.1 )then
252          print *,' In step fizhi corr, new fizhi fields ',bi,' dt= ',dt
253          do L = 1,Nrphys
254           do j = jdim1,jdim2
255           do i = idim1,idim2
256            tempij(i,j) = uphy(i,j,L,bi,bj)
257           enddo
258           enddo
259    c      print *,' uphy at level ',l,' ',tempij
260          enddo
261          do L = 1,Nrphys
262           do j = jdim1,jdim2
263           do i = idim1,idim2
264            tempij(i,j) = vphy(i,j,L,bi,bj)
265           enddo
266           enddo
267    c      print *,' vphy at level ',l,' ',tempij
268          enddo
269          do L = 1,Nrphys
270           do j = jdim1,jdim2
271           do i = idim1,idim2
272            tempij(i,j) = thphy(i,j,L,bi,bj)
273           enddo
274           enddo
275           print *,' thphy at level ',l,' ',tempij
276          enddo
277          do L = 1,Nrphys
278           do j = jdim1,jdim2
279           do i = idim1,idim2
280            tempij(i,j) = sphy(i,j,L,bi,bj)
281           enddo
282           enddo
283           print *,' sphy at level ',l,' ',tempij
284          enddo
285          endif
286    
287            call qcheck (im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,idim1,idim2,
288         .         jdim1,jdim2,bi,bj,dpphys,sphy)
289    
290          if(2.eq.1 )then
291          print *,' In step fizhi corr after qcheck ',bi
292          do L = 1,Nrphys
293           do j = jdim1,jdim2
294           do i = idim1,idim2
295            tempij(i,j) = sphy(i,j,L,bi,bj)
296           enddo
297           enddo
298           print *,' sphy after qcheck at level ',l,' ',tempij
299          enddo
300          endif
301    
302    
303         enddo         enddo
304         enddo         enddo
305    
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22