/[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.20 by molod, Thu Oct 7 00:06:09 2004 UTC revision 1.31 by molod, Thu May 18 23:04:46 2006 UTC
# Line 19  c--------------------------------------- Line 19  c---------------------------------------
19  #include "SIZE.h"  #include "SIZE.h"
20  #include "GRID.h"  #include "GRID.h"
21  #include "EEPARAMS.h"  #include "EEPARAMS.h"
22    #include "PARAMS.h"
23  #include "SURFACE.h"  #include "SURFACE.h"
24  #include "DYNVARS.h"  #include "DYNVARS.h"
25  #include "fizhi_land_SIZE.h"  #include "fizhi_land_SIZE.h"
# Line 29  c--------------------------------------- Line 30  c---------------------------------------
30  #include "fizhi_earth_coms.h"  #include "fizhi_earth_coms.h"
31  #include "fizhi_ocean_coms.h"  #include "fizhi_ocean_coms.h"
32  #include "fizhi_chemistry_coms.h"  #include "fizhi_chemistry_coms.h"
33    #ifdef ALLOW_DIAGNOSTICS
34         integer myTime, myIter, myThid  #include "fizhi_SHP.h"
35    #endif
36    
37           integer myIter, myThid
38           _RL myTime
39           logical  diagnostics_is_on
40           external diagnostics_is_on
41    
42  c pe on dynamics and physics grid refers to bottom edge  c pe on dynamics and physics grid refers to bottom edge
43         _RL pephy4fiz(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nrphys+1,nSx,nSy)         _RL pephy4fiz(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nrphys+1,nSx,nSy)
# Line 38  c pe on dynamics and physics grid refers Line 45  c pe on dynamics and physics grid refers
45         _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)
46         _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)
47         _RL fracland(sNx,sNy,Nsx,Nsy)         _RL fracland(sNx,sNy,Nsx,Nsy)
48           _RL tempLdiag(sNx,sNy,Nrphys,Nsx,Nsy)
49           _RL tempLdiag2(sNx,sNy,Nrphys,Nsx,Nsy)
50           _RL tempdiag(sNx,sNy,Nsx,Nsy)
51           _RL slp(sNx,sNy)
52    
53         integer i, j, L, Lbotij, bi, bj         integer i, j, L, Lbotij, bi, bj
54         integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2         integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
55         _RL tempij(sNx,sNy)         _RL tempij(1-olx:sNx+olx,1-oly:sNy+oly)
56    
57         idim1 = 1-OLx         idim1 = 1-OLx
58         idim2 = sNx+OLx         idim2 = sNx+OLx
# Line 52  c pe on dynamics and physics grid refers Line 63  c pe on dynamics and physics grid refers
63         jm1 = 1         jm1 = 1
64         jm2 = sNy         jm2 = sNy
65    
66    #ifdef ALLOW_DIAGNOSTICS
67          if ( useDiagnostics ) then
68           if(diagnostics_is_on('TENDUFIZ',myThid) .or.
69         .       diagnostics_is_on('CORRDU  ',myThid) ) then
70            do bj = myByLo(myThid), myByHi(myThid)
71            do bi = myBxLo(myThid), myBxHi(myThid)
72            do L = 1,Nrphys
73            do j = 1,sNy
74            do i = 1,sNx
75             ubef(i,j,L,bi,bj) = uphy(i,j,L,bi,bj)
76            enddo
77            enddo
78            enddo
79            do L = 1,Nr
80            do j = 1,sNy
81            do i = 1,sNx+1
82             udynbef(i,j,L,bi,bj) = uvel(i,j,L,bi,bj)
83            enddo
84            enddo
85            enddo
86            enddo
87            enddo
88           endif
89           if(diagnostics_is_on('TENDVFIZ',myThid) .or.
90         .       diagnostics_is_on('CORRDV  ',myThid) ) then
91            do bj = myByLo(myThid), myByHi(myThid)
92            do bi = myBxLo(myThid), myBxHi(myThid)
93            do L = 1,Nrphys
94            do j = 1,sNy
95            do i = 1,sNx
96             vbef(i,j,L,bi,bj) = vphy(i,j,L,bi,bj)
97            enddo
98            enddo
99            enddo
100            do L = 1,Nr
101            do j = 1,sNy+1
102            do i = 1,sNx
103             vdynbef(i,j,L,bi,bj) = vvel(i,j,L,bi,bj)
104            enddo
105            enddo
106            enddo
107            enddo
108            enddo
109           endif
110           if(diagnostics_is_on('TENDTFIZ',myThid) .or.
111         .       diagnostics_is_on('CORRDT  ',myThid) ) then
112            do bj = myByLo(myThid), myByHi(myThid)
113            do bi = myBxLo(myThid), myBxHi(myThid)
114            do L = 1,Nrphys
115            do j = 1,sNy
116            do i = 1,sNx
117             thbef(i,j,L,bi,bj) = thphy(i,j,L,bi,bj)
118            enddo
119            enddo
120            enddo
121            do L = 1,Nr
122            do j = 1,sNy
123            do i = 1,sNx
124             thdynbef(i,j,L,bi,bj) = theta(i,j,L,bi,bj)
125            enddo
126            enddo
127            enddo
128            enddo
129            enddo
130           endif
131           if(diagnostics_is_on('TENDQFIZ',myThid) .or.
132         .       diagnostics_is_on('CORRDQ  ',myThid) ) then
133            do bj = myByLo(myThid), myByHi(myThid)
134            do bi = myBxLo(myThid), myBxHi(myThid)
135            do L = 1,Nrphys
136            do j = 1,sNy
137            do i = 1,sNx
138             sbef(i,j,L,bi,bj) = sphy(i,j,L,bi,bj)
139            enddo
140            enddo
141            enddo
142            do L = 1,Nr
143            do j = 1,sNy
144            do i = 1,sNx
145             sdynbef(i,j,L,bi,bj) = salt(i,j,L,bi,bj)
146            enddo
147            enddo
148            enddo
149            enddo
150            enddo
151           endif
152          endif
153    #endif
154    
155         do bj = myByLo(myThid), myByHi(myThid)         do bj = myByLo(myThid), myByHi(myThid)
156         do bi = myBxLo(myThid), myBxHi(myThid)         do bi = myBxLo(myThid), myBxHi(myThid)
157    
# Line 102  c Do not use a zero field as the top edg Line 202  c Do not use a zero field as the top edg
202         enddo         enddo
203         enddo         enddo
204    
205    #ifdef ALLOW_DIAGNOSTICS
206          if ( useDiagnostics ) then
207           if(diagnostics_is_on('FIZPRES ',myThid) ) then
208            do bj = myByLo(myThid), myByHi(myThid)
209            do bi = myBxLo(myThid), myBxHi(myThid)
210            do j = 1,sNy
211            do i = 1,sNx
212            do L = 1,Nrphys
213             tempphy(i,j,L,bi,bj) = pephy4fiz(i,j,L,bi,bj)
214            enddo
215            enddo
216            enddo
217            enddo
218            enddo
219            call diagnostics_fill(tempphy,'FIZPRES ',0,
220         .                                     Nrphys,0,1,1,myThid)
221           endif
222          endif
223    #endif
224    
225         CALL TIMER_START ('DO_FIZHI          [FIZHI_WRAPPER]',mythid)         CALL TIMER_START ('DO_FIZHI          [FIZHI_WRAPPER]',mythid)
226         do bj = myByLo(myThid), myByHi(myThid)         do bj = myByLo(myThid), myByHi(myThid)
227         do bi = myBxLo(myThid), myBxHi(myThid)         do bi = myBxLo(myThid), myBxHi(myThid)
228          call get_landfrac(im2,jm2,Nsx,Nsy,bi,bj,maxtyp,          call get_landfrac(im2,jm2,Nsx,Nsy,bi,bj,maxtyp,
229       .        surftype,tilefrac,fracland)       .        surftype,tilefrac,fracland(1,1,bi,bj))
230    
231    #ifdef ALLOW_DIAGNOSTICS
232          if ( useDiagnostics ) then
233           if(diagnostics_is_on('SLP     ',myThid) ) then
234            do j = 1,sNy
235            do i = 1,sNx
236             tempdiag(i,j,bi,bj) = Phihydlow(i,j,bi,bj)
237            do L = 1,Nrphys+1
238             tempLdiag(i,j,L,bi,bj) = pephy4fiz(i,j,L,bi,bj)
239             tempLdiag2(i,j,L,bi,bj) = thphy(i,j,L,bi,bj)
240            enddo
241            enddo
242            enddo
243            call slprs(tempdiag,tempLdiag(1,1,1,bi,bj),
244         .  tempLdiag2(1,1,1,bi,bj),fracland(1,1,bi,bj),sNx,sNy,Nrphys,slp)
245            do j = 1,sNy
246            do i = 1,sNx
247             tempij(i,j) = slp(i,j)
248            enddo
249            enddo
250            call diagnostics_fill(tempij,'SLP     ',1,
251         .                                     1,2,bi,bj,myThid)
252           endif
253          endif
254    #endif
255    
256  c  c
257  c Compute physics increments  c Compute physics increments
258    
259          call do_fizhi(myThid,          call do_fizhi(myIter,myThid,
260       .  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,
261       .  nchp,nchptot,nchpland,       .  nchp,nchptot,nchpland,
262       .  uphy,vphy,thphy,sphy,pephy4fiz,xC,yC,       .  uphy,vphy,thphy,sphy,pephy4fiz,xC,yC,topoZ,
263       .  ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,       .  ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
264       .  tgz,sst,sice,phis_var,landtype,fracland,emiss,albnirdr,albnirdf,       .  tgz,sst,sice,phis_var,landtype,fracland,emiss,albnirdr,albnirdf,
265       .  albvisdr,albvisdf,ityp,chfr,alai,agrn,igrd,chlt,chlon,       .  albvisdr,albvisdf,ityp,chfr,alai,agrn,igrd,chlt,chlon,
# Line 122  c Compute physics increments Line 268  c Compute physics increments
268       .  iras,nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,       .  iras,nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,
269       .  nswcld,cldtot_sw,cldras_sw,cldlsp_sw,nswlz,swlz,       .  nswcld,cldtot_sw,cldras_sw,cldlsp_sw,nswlz,swlz,
270       .  imstturbsw,imstturblw,qliqavesw,qliqavelw,fccavesw,fccavelw,       .  imstturbsw,imstturblw,qliqavesw,qliqavelw,fccavesw,fccavelw,
271         .  raincon,rainlsp,snowfall,
272       .  duphy,dvphy,dthphy,dsphy)       .  duphy,dvphy,dthphy,dsphy)
273         enddo         enddo
274         enddo         enddo
# Line 171  C   into bottom-up arrays for interpolat Line 318  C   into bottom-up arrays for interpolat
318          call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,          call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
319       . 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)
320    
   
         if( (2.eq.1) ) then  
         print *,' In fizhi wrapper after phys2dyn before exchange ',bi  
         do L = 1,Nr  
          do j = 1,sNy  
          do i = 1,sNx  
           tempij(i,j) = guphy(i,j,L,bi,bj)  
          enddo  
          enddo  
 c        print *,' guphy at level ',l,' ',tempij  
         enddo  
         do L = 1,Nr  
          do j = 1,sNy  
          do i = 1,sNx  
           tempij(i,j) = gvphy(i,j,L,bi,bj)  
          enddo  
          enddo  
 c        print *,' gvphy at level ',l,' ',tempij  
         enddo  
         do L = 1,Nr  
          do j = 1,sNy  
          do i = 1,sNx  
           tempij(i,j) = gthphy(i,j,L,bi,bj)  
          enddo  
          enddo  
          print *,' gthphy at level ',l,' ',tempij  
         enddo  
         do L = 1,Nr  
          do j = 1,sNy  
          do i = 1,sNx  
           tempij(i,j) = gsphy(i,j,L,bi,bj)  
          enddo  
          enddo  
 c        print *,' gsphy at level ',l,' ',tempij  
         enddo  
         endif  
321         enddo         enddo
322         enddo         enddo
323    
# Line 222  c Convert guphy and gvphy from A-grid to Line 333  c Convert guphy and gvphy from A-grid to
333  c Call the c-grid exchange routine to fill in the halo regions (du,dv)  c Call the c-grid exchange routine to fill in the halo regions (du,dv)
334         call exch_uv_xyz_RL(guphy,gvphy,.TRUE.,myThid)         call exch_uv_xyz_RL(guphy,gvphy,.TRUE.,myThid)
335  c Call the a-grid exchange routine to fill in the halo regions (dth,ds)  c Call the a-grid exchange routine to fill in the halo regions (dth,ds)
336         call exch_RL_cube(gthphy,OLx, OLx, OLy, OLy, Nr,OLx, OLy,         _EXCH_XYZ_R8(gthphy,myThid)
337       .            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )         _EXCH_XYZ_R8(gsphy,myThid)
        call exch_RL_cube(gsphy,OLx, OLx, OLy, OLy, Nr,OLx, OLy,  
      .            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )  
338         CALL TIMER_STOP ('EXCHANGES         [FIZHI_WRAPPER]',mythid)         CALL TIMER_STOP ('EXCHANGES         [FIZHI_WRAPPER]',mythid)
339    
        do bj = myByLo(myThid), myByHi(myThid)  
        do bi = myBxLo(myThid), myBxHi(myThid)  
         if( (2.eq.1) ) then  
         print *,' In fizhi wrapper after exchange ',bi  
         do L = 1,Nr  
          do j = 1,sNy  
          do i = 1,sNx  
           tempij(i,j) = guphy(i,j,L,bi,bj)  
          enddo  
          enddo  
          print *,' guphy at level ',l,' ',tempij  
         enddo  
         do L = 1,Nr  
          do j = 1,sNy  
          do i = 1,sNx  
           tempij(i,j) = gvphy(i,j,L,bi,bj)  
          enddo  
          enddo  
          print *,' gvphy at level ',l,' ',tempij  
         enddo  
         do L = 1,Nr  
          do j = 1,sNy  
          do i = 1,sNx  
           tempij(i,j) = gthphy(i,j,L,bi,bj)  
          enddo  
          enddo  
          print *,' gthphy at level ',l,' ',tempij  
         enddo  
         do L = 1,Nr  
          do j = 1,sNy  
          do i = 1,sNx  
           tempij(i,j) = gsphy(i,j,L,bi,bj)  
          enddo  
          enddo  
          print *,' gsphy at level ',l,' ',tempij  
         enddo  
         endif  
        enddo  
        enddo  
   
340        return        return
341        end        end
Legend:
Removed from v.1.20  
changed lines
  Added in v.1.31
  ViewVC Help
Powered by ViewVC 1.1.22