/[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.9 by molod, Tue Jun 15 21:18:18 2004 UTC revision 1.14 by molod, Mon Jul 26 18:45:17 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 37  c pe on dynamics and physics grid refers Line 37  c pe on dynamics and physics grid refers
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)         _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
# Line 58  C  Note: Need one array to send to fizhi Line 59  C  Note: Need one array to send to fizhi
59  C        For the interpolations between physics and dynamics (bottom-up)  C        For the interpolations between physics and dynamics (bottom-up)
60          do j = 1,sNy          do j = 1,sNy
61          do i = 1,sNx          do i = 1,sNx
62           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)  
63           do L = 2,Nrphys+1           do L = 2,Nrphys+1
64            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)
65           enddo           enddo
# Line 83  C Build pressures on dynamics grid Line 83  C Build pressures on dynamics grid
83          do i = 1,sNx          do i = 1,sNx
84           Lbotij = ksurfC(i,j,bi,bj)           Lbotij = ksurfC(i,j,bi,bj)
85           if(Lbotij.ne.0.)           if(Lbotij.ne.0.)
86       . 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)  
87          enddo          enddo
88          enddo          enddo
89          do j = 1,sNy          do j = 1,sNy
# Line 105  c Do not use a zero field as the top edg Line 104  c Do not use a zero field as the top edg
104         CALL TIMER_START ('DO_FIZHI          [FIZHI_WRAPPER]',mythid)         CALL TIMER_START ('DO_FIZHI          [FIZHI_WRAPPER]',mythid)
105         do bj = myByLo(myThid), myByHi(myThid)         do bj = myByLo(myThid), myByHi(myThid)
106         do bi = myBxLo(myThid), myBxHi(myThid)         do bi = myBxLo(myThid), myBxHi(myThid)
107            call get_landfrac(im2,jm2,Nsx,Nsy,bi,bj,maxtyp,
108         .        surftype,tilefrac,fracland)
109  c  c
110  c Compute physics increments  c Compute physics increments
111          call do_fizhi(uphy,vphy,thphy,sphy,pephy4fiz,xC,yC,          call do_fizhi(myThid,uphy,vphy,thphy,sphy,pephy4fiz,xC,yC,
112       .   ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,       .  ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
113       .   sst,sice,phis_var,landtype,emiss,albnidr,albnirdf,       .  tgz,sst,sice,phis_var,landtype,fracland,emiss,albnirdr,albnirdf,
114       .   albvisdr,albvisdf,ityp,chfr,alai,agrn,igrd,chlat,chlon,       .  albvisdr,albvisdf,ityp,chfr,alai,agrn,igrd,chlt,chlon,
115       .   tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,snodep,capac,       .  tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,snodep,capac,
116       .   o3,qstr,co2,cfc11,cfc12,cfc22,n2o,methane,       .  o3,qstr,co2,cfc11,cfc12,cfc22,n2o,methane,
117       .   idim1,idim2,jdim1,jdim2,Nrphys,Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,       .  idim1,idim2,jdim1,jdim2,Nrphys,Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,
118       .   nchp,       .  nchp,nchptot,nchpland,
119       .   duphy,dvphy,dthphy,dsphy)       .  duphy,dvphy,dthphy,dsphy)
120         enddo         enddo
121         enddo         enddo
122         CALL TIMER_STOP ('DO_FIZHI          [FIZHI_WRAPPER]',mythid)         CALL TIMER_STOP ('DO_FIZHI          [FIZHI_WRAPPER]',mythid)
# Line 129  C   into bottom-up arrays for interpolat Line 130  C   into bottom-up arrays for interpolat
130          do j = 1,sNy          do j = 1,sNy
131          do i = 1,sNx          do i = 1,sNx
132           do L = 1,Nrphys           do L = 1,Nrphys
133            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)
134           enddo           enddo
135          enddo          enddo
136          enddo          enddo
137          call phys2dyn(tmpphys,pephy,idim1,idim2,jdim1,jdim2,Nrphys,          call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
138       . 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)
139          do j = 1,sNy          do j = 1,sNy
140          do i = 1,sNx          do i = 1,sNx
141           do L = 1,Nrphys           do L = 1,Nrphys
142            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)
143           enddo           enddo
144          enddo          enddo
145          enddo          enddo
146          call phys2dyn(tmpphys,pephy,idim1,idim2,jdim1,jdim2,Nrphys,          call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
147       . 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)
148          do j = 1,sNy          do j = 1,sNy
149          do i = 1,sNx          do i = 1,sNx
150           do L = 1,Nrphys           do L = 1,Nrphys
151            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)
152           enddo           enddo
153          enddo          enddo
154          enddo          enddo
155          call phys2dyn(tmpphys,pephy,idim1,idim2,jdim1,jdim2,Nrphys,          call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
156       . 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)
157          do j = 1,sNy          do j = 1,sNy
158          do i = 1,sNx          do i = 1,sNx
159           do L = 1,Nrphys           do L = 1,Nrphys
160            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)
161           enddo           enddo
162          enddo          enddo
163          enddo          enddo
164          call phys2dyn(tmpphys,pephy,idim1,idim2,jdim1,jdim2,Nrphys,          call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
165       . 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)
166    
167         enddo         enddo
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22