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

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

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

revision 1.3 by molod, Thu Jun 10 21:50:33 2004 UTC revision 1.4 by molod, Fri Jun 11 18:50:04 2004 UTC
# Line 17  c--------------------------------------- Line 17  c---------------------------------------
17  #include "GRID.h"  #include "GRID.h"
18  #include "DYNVARS.h"  #include "DYNVARS.h"
19  #include "fizhi_chemistry_coms.h"  #include "fizhi_chemistry_coms.h"
20    #include "fizhi_coms.h"
21  #include "gridalt_mapping.h"  #include "gridalt_mapping.h"
22  #include "EEPARAMS.h"  #include "EEPARAMS.h"
23    #include "chronos.h"
24    
25         integer myTime, myIter, myThid        integer myTime, myIter, myThid
26    
27  c pe on physics grid refers to bottom edge  c pe on physics grid refers to bottom edge
28         _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)
29          _RL pphy(sNx,sNy,Nrphys,nSx,nSy)
30          _RL oz1(nlatsoz,nlevsoz), strq1(nlatsq,nlevsq)
31          _RL waterin(sNx,sNy,Nrphys), xlat(sNx,sNy)
32    
33          integer i, j, L, bi, bj
34          integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
35          integer nhms1,nymd1,nhms2,nymd2,imns,ipls
36          _RL facm, facp
37    
38          im1 = 1-OLx
39          im2 = sNx+OLx
40          jm1 = 1-OLy
41          jm2 = sNy+OLy
42          idim1 = 1
43          idim2 = sNx
44          jdim1 = 1
45          jdim2 = sNy
46    
47          if( alarm('radsw').or.alarm('radlw') ) then
48    
        integer i, j, L, bi, bj  
        integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2  
                                                                                       
        im1 = 1-OLx  
        im2 = sNx+OLx  
        jm1 = 1-OLy  
        jm2 = sNy+OLy  
        idim1 = 1  
        idim2 = sNx  
        jdim1 = 1  
        jdim2 = sNy  
                                                                                       
49         do bj = myByLo(myThid), myByHi(myThid)         do bj = myByLo(myThid), myByHi(myThid)
50         do bi = myBxLo(myThid), myBxHi(myThid)         do bi = myBxLo(myThid), myBxHi(myThid)
51    
52  C Compute pressures on physics grid  c  Construct the physics grid pressures
53          do j = 1,sNy          do j = 1,sNy
54          do i = 1,sNx          do i = 1,sNx
55           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))/
56         .                       rstarExpC(i,j,bi,bj)
57           do L = 2,Nrphys+1           do L = 2,Nrphys+1
58            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)
59           enddo           enddo
# Line 52  c Do not use a zero field as the top edg Line 62  c Do not use a zero field as the top edg
62       .                               pephy(i,j,Nrphys+1,bi,bj) = 1.e-5       .                               pephy(i,j,Nrphys+1,bi,bj) = 1.e-5
63          enddo          enddo
64          enddo          enddo
65            do j = 1,sNy
66            do i = 1,sNx
67             do L = 1,Nrphys
68              pphy(i,j,L,bi,bj)=(pephy(i,j,L+1,bi,bj)+pephy(i,j,L,bi,bj))/2.
69             enddo
70            enddo
71            enddo
72    
73  call time-bound          do j = 1,sNy
74  call interp_time          do i = 1,sNx
75  call interp chemistry           xlat(i,j) = yC(i,j,bi,bj)
76  c reminder - lats are in yC and lons in xC in GRID.h           do L = 1,Nrphys
77              waterin(i,j,L) = sphy(i,j,L,bi,bj)
78             enddo
79            enddo
80            enddo
81    
82            call time_bound(nymd,nhms,nymd1,nhms1,nymd2,nhms2,imns,ipls)
83            call interp_time(nymd,nhms,nymd1,nhms1,nymd2,nhms2,facm,facp)
84    
85            do L = 1,nlevsoz
86            do j = 1,nlatsoz
87             oz1(j,L) = ozone(j,L,imns)*facm + ozone(j,L,ipls)*facp
88            enddo
89            enddo
90                                                                                
91            do L = 1,nlevsq
92            do j = 1,nlatsq
93             strq1(j,L) = stratq(j,L,imns)*facm + stratq(j,L,ipls)*facp
94            enddo
95            enddo
96    
97            call interp_chemistry(strq1,nlevsq,nlatsq,levsq,latsq,
98         .   oz1,nlevsoz,nlatsoz,levsoz,latsoz,waterin,pphy,xlat,
99         .   im2,jm2,Nrphys,nSx,nSy,bi,bj,o3,qstr)
100    
101         enddo         enddo
102         enddo         enddo
103    
104         return        endif
105         end  
106          return
107          end
108    
109        subroutine interp_chemistry (stratq,nwatlevs,nwatlats,watlevs,        subroutine interp_chemistry (stratq,nwatlevs,nwatlats,watlevs,
110       . watlats,ozone,nozolevs,nozolats,ozolevs,ozolats,       . watlats,ozone,nozolevs,nozolats,ozolevs,ozolats,
111       . qz,plz,ptop,xlat,im,jm,lm,ozrad,qzrad)       . qz,plz,ptop,xlat,im,jm,lm,nSx,nSy,bi,bj,ozrad,qzrad)
112    
113        implicit none        implicit none
114    
115  c Input Variables  c Input Variables
116  c ---------------  c ---------------
117        integer nwatlevs,nwatlats,nozolevs,nozolats        integer nwatlevs,nwatlats,nozolevs,nozolats,nSx,nSy,bi,bj
118        real stratq(nwatlats,nwatlevs),ozone(nozlats,nozlevs)        real stratq(nwatlats,nwatlevs),ozone(nozlats,nozlevs)
119        integer watlevs(nwatlevs),watlats(nwatlats)        integer watlevs(nwatlevs),watlats(nwatlats)
120        integer ozlevs(nozlevs),ozlats(nozlats)        integer ozlevs(nozlevs),ozlats(nozlats)
121        real qz(im,jm,lm),plz(im,jm,lm)        real qz(im,jm,lm),plz(im,jm,lm)
122        real ptop, xlat(im,jm)        real ptop, xlat(im,jm)
123        integer im,jm,lm        integer im,jm,lm
124        real ozrad(im,jm,lm)        real ozrad(im,jm,lm,nSx,nSy)
125        real qzrad(im,jm,lm)        real qzrad(im,jm,lm,nSx,nSy)
126    
127  c Local Variables  c Local Variables
128  c ---------------  c ---------------
# Line 92  C ****           Get Ozone and Stratosph Line 134  C ****           Get Ozone and Stratosph
134  C **********************************************************************  C **********************************************************************
135    
136        call interp_qz (stratq,nwatlevs,nwatlats,watlevs,watlats,im*jm,        call interp_qz (stratq,nwatlevs,nwatlats,watlevs,watlats,im*jm,
137       .                                             xlat,lm,plz,qz,qzrad)       .                                xlat,lm,plz,qz,qzrad(1,1,1,bi,bj))
138        call interp_oz (ozone ,nozolevs,nozolats,ozolevs,ozolats,im*jm,        call interp_oz (ozone ,nozolevs,nozolats,ozolevs,ozolats,im*jm,
139       .                                             xlat,lm,plz,   ozrad)       .                                xlat,lm,plz,ozrad(1,1,1,bi,bj))
140        return        return
141        end        end
142    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22