/[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.3 by molod, Tue Mar 30 18:28:44 2004 UTC revision 1.12 by molod, Fri Jul 16 16:11:36 2004 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4    #include "CPP_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 12  c        phys2dyn (4 calls - all physics Line 16  c        phys2dyn (4 calls - all physics
16  c        AtoC (u and v tendencies)  c        AtoC (u and v tendencies)
17  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
18         implicit none         implicit none
 #include "CPP_OPTIONS.h"  
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    
45         im1 = 1-OLx         idim1 = 1-OLx
46         im2 = sNx+OLx         idim2 = sNx+OLx
47         jm1 = 1-OLy         jdim1 = 1-OLy
48         jm2 = sNy+OLy         jdim2 = sNy+OLy
49         idim1 = 1         im1 = 1
50         idim2 = sNx         im2 = sNx
51         jdim1 = 1         jm1 = 1
52         jdim2 = sNy         jm2 = sNy
53    
54         do bj = myByLo(myThid), myByHi(myThid)         do bj = myByLo(myThid), myByHi(myThid)
55         do bi = myBxLo(myThid), myBxHi(myThid)         do bi = myBxLo(myThid), myBxHi(myThid)
56    
57  c  Construct the physics grid pressures  c Construct the physics grid pressures
58    C  Note: Need one array to send to fizhi (top-down) and another
59    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
66  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
67             do L = 1,Nrphys+1
68              pephy4fiz(i,j,Nrphys+2-L,bi,bj)=pephy(i,j,L,bi,bj)
69             enddo
70           if(pephy(i,j,Nrphys+1,bi,bj).lt.1.e-5)           if(pephy(i,j,Nrphys+1,bi,bj).lt.1.e-5)
71       .                               pephy(i,j,Nrphys+1,bi,bj) = 1.e-5       .                               pephy(i,j,Nrphys+1,bi,bj) = 1.e-5
72          enddo          enddo
# Line 70  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 92  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,pephy,          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       .                  xC,yC,       .  tgz,sst,sice,phis_var,landtype,fracland,emiss,albnirdr,albnirdf,
114       .            im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,1,sNx,1,sNy,bi,bj,nchp,       .  albvisdr,albvisdf,ityp,chfr,alai,agrn,igrd,chlt,chlon,
115       .                                         duphy,dvphy,dthphy,dsphy)       .  tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,snodep,capac,
116         .  o3,qstr,co2,cfc11,cfc12,cfc22,n2o,methane,
117         .  idim1,idim2,jdim1,jdim2,Nrphys,Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,
118         .  nchp,nchpland,
119         .  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 107  c Compute physics increments Line 125  c Compute physics increments
125         do bj = myByLo(myThid), myByHi(myThid)         do bj = myByLo(myThid), myByHi(myThid)
126         do bi = myBxLo(myThid), myBxHi(myThid)         do bi = myBxLo(myThid), myBxHi(myThid)
127  c Interpolate (A-Grid) physics increments to dynamics grid  c Interpolate (A-Grid) physics increments to dynamics grid
128          call phys2dyn(duphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,  C   First flip the physics arrays (which are top-down)
129       .       1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,guphy)  C   into bottom-up arrays for interpolation to dynamics grid
130          call phys2dyn(dvphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,          do j = 1,sNy
131       .       1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gvphy)          do i = 1,sNx
132          call phys2dyn(dthphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,           do L = 1,Nrphys
133       .       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)
134          call phys2dyn(dsphy,pephy,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,           enddo
135       .       1,sNx,1,sNy,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gsphy)          enddo
136            enddo
137            call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
138         . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,guphy)
139            do j = 1,sNy
140            do i = 1,sNx
141             do L = 1,Nrphys
142              tempphy(i,j,Nrphys+1-L,bi,bj)=dvphy(i,j,L,bi,bj)
143             enddo
144            enddo
145            enddo
146            call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
147         . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gvphy)
148            do j = 1,sNy
149            do i = 1,sNx
150             do L = 1,Nrphys
151              tempphy(i,j,Nrphys+1-L,bi,bj)=dthphy(i,j,L,bi,bj)
152             enddo
153            enddo
154            enddo
155            call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
156         . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gthphy)
157            do j = 1,sNy
158            do i = 1,sNx
159             do L = 1,Nrphys
160              tempphy(i,j,Nrphys+1-L,bi,bj)=dsphy(i,j,L,bi,bj)
161             enddo
162            enddo
163            enddo
164            call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
165         . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gsphy)
166    
167         enddo         enddo
168         enddo         enddo
# Line 122  c Interpolate (A-Grid) physics increment Line 170  c Interpolate (A-Grid) physics increment
170    
171  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
172         CALL TIMER_START ('ATOC              [FIZHI_WRAPPER]',mythid)         CALL TIMER_START ('ATOC              [FIZHI_WRAPPER]',mythid)
173         call AtoC(myThid,guphy,gvphy,maskC,im1,im2,jm1,jm2,Nr,         call AtoC(myThid,guphy,gvphy,maskC,idim1,idim2,jdim1,jdim2,Nr,
174       .                      Nsx,Nsy,1,sNx,1,sNy,guphy,gvphy)       .                      Nsx,Nsy,im1,im2,jm1,jm2,guphy,gvphy)
175         CALL TIMER_STOP ('ATOC              [FIZHI_WRAPPER]',mythid)         CALL TIMER_STOP ('ATOC              [FIZHI_WRAPPER]',mythid)
176    
177         CALL TIMER_START ('EXCHANGES         [FIZHI_WRAPPER]',mythid)         CALL TIMER_START ('EXCHANGES         [FIZHI_WRAPPER]',mythid)
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22