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

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

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

revision 1.2 by molod, Thu Jul 8 15:01:02 2004 UTC revision 1.4 by molod, Mon Jul 26 18:45:17 2004 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3                                                                                        
4    #include "FIZHI_OPTIONS.h"
5        SUBROUTINE PQCHECK ( PQZ,PZ,DP,IM,JM,LM,delt)        SUBROUTINE PQCHECK ( PQZ,PZ,DP,IM,JM,LM,delt)
6  C***********************************************************************  C***********************************************************************
7  C  Purpose                                                                C  Purpose                                                              
# Line 17  C*************************************** Line 21  C***************************************
21        implicit none        implicit none
22    
23        integer im,jm,lm        integer im,jm,lm
24        real delt        _RL delt
25    
26        real     PQZ(IM,JM,LM), DP(IM,JM,LM)                                _RL     PQZ(IM,JM,LM), DP(IM,JM,LM)                        
27        real      PZ(IM,JM)        _RL      PZ(IM,JM)
28    
29        integer i,j,L,LM1        integer i,j,L,LM1
30        real    getcon,grav,ddsig        _RL    getcon,grav,ddsig
       real    tmp1(im,jm)  
31    
32        grav = getcon('GRAVITY')        grav = getcon('GRAVITY')
33    
# Line 73  C     the sum of immediate surrounding p Line 76  C     the sum of immediate surrounding p
76  C     If sum is not large enough, tracer is simply set to zero.  C     If sum is not large enough, tracer is simply set to zero.
77  C                                                                        C                                                                      
78  C***********************************************************************  C***********************************************************************
 C*                  GODDARD LABORATORY FOR ATMOSPHERES                 *  
 C***********************************************************************  
79    
80        implicit none        implicit none
81    
82  c Input Variables  c Input Variables
83  c ---------------  c ---------------
84        integer im,jm,lm        integer im,jm,lm
85        real    pq(im,jm,lm),dlam(im),dphi(jm),dp(im,jm,lm)        _RL    pq(im,jm,lm),dlam(im),dphi(jm),dp(im,jm,lm)
86    
87  c Local Variables  c Local Variables
88  c ---------------  c ---------------
89        integer  i,j,l,im1,ip1,imax,m        integer  i,j,l,im1,ip1,imax,m
90        real     lam(im), phi(jm)        _RL     lam(im), phi(jm)
91        real     array(6)        _RL     array(6)
92        real     pi,a,getcon,undef        _RL     pi,a,getcon,undef
93        real     qmax,qval,sum,fact        _RL     qmax,qval,sum,fact
94    
95        real        dxu(im,jm)        _RL        dxu(im,jm)
96        real        dxv(im,jm)        _RL        dxv(im,jm)
97        real        dxp(im,jm)        _RL        dxp(im,jm)
98        real        dyv(im,jm)        _RL        dyv(im,jm)
99        real        dyp(im,jm)        _RL        dyp(im,jm)
   
       real, allocatable, save :: d2p(:,:)  
100    
101        logical first        _RL d2p(im,jm)
       data    first /.true./  
102    
103  C *********************************************************  C *********************************************************
104  C ****                 Initialization                  ****  C ****                 Initialization                  ****
105  C *********************************************************  C *********************************************************
106    
       if (first) then  
   
       allocate ( d2p(im,jm) )  
107        pi = 4.0*atan(1.0)        pi = 4.0*atan(1.0)
108        a  = getcon('EARTH RADIUS')        a  = getcon('EARTH RADIUS')
109    
# Line 185  c ----------------------- Line 180  c -----------------------
180        d2p(i,jm-1) = dxv(i,jm-2)*dyp(i,jm-1)        d2p(i,jm-1) = dxv(i,jm-2)*dyp(i,jm-1)
181        enddo        enddo
182    
       first = .false.  
       endif  
   
183        undef = getcon('UNDEF')        undef = getcon('UNDEF')
184    
185  C *********************************************************  C *********************************************************
# Line 220  C ************************************** Line 212  C **************************************
212        if( L.eq.1    ) then        if( L.eq.1    ) then
213        array(5) = -undef        array(5) = -undef
214        else        else
215        array(5) = pq(i,j,L-1)*d2p(i,j)*dp(i,j,L)1)        array(5) = pq(i,j,L-1)*d2p(i,j)*dp(i,j,L)
216        endif        endif
217        if( L.eq.lm   ) then        if( L.eq.lm   ) then
218        array(6) = -undef        array(6) = -undef
219        else        else
220        array(6) = pq(i,j,L+1)*d2p(i,j)*dp(i,j,L)1)        array(6) = pq(i,j,L+1)*d2p(i,j)*dp(i,j,L)
221        endif        endif
222    
223        call maxval (array,6,-qval,qmax,imax)        call maxval1 (array,6,-qval,qmax,imax)
224    
225        if( imax.eq.0 ) then        if( imax.eq.0 ) then
226            sum = 0.0            sum = 0.0
# Line 274  C ************************************** Line 266  C **************************************
266        return        return
267        end        end
268    
269        subroutine maxval (q,im,qval,qmax,imax)        subroutine maxval1 (q,im,qval,qmax,imax)
270  C***********************************************************************  C***********************************************************************
271  C  PURPOSE                                                                C  PURPOSE                                                              
272  C     Find the location and value of the array element which is greater  C     Find the location and value of the array element which is greater
# Line 293  C  Note: Line 285  C  Note:
285  C     If no array element is larger than qval, then imax = 0          C     If no array element is larger than qval, then imax = 0        
286  C                                                                        C                                                                      
287  C***********************************************************************  C***********************************************************************
 C*                  GODDARD LABORATORY FOR ATMOSPHERES                 *  
 C***********************************************************************  
288        implicit none        implicit none
289        integer  im, i, imax        integer  im, i, imax
290        real   q(im), qmax, qval        _RL   q(im), qmax, qval
291        qmax = qval        qmax = qval
292        imax = 0        imax = 0
293        do i=1,im        do i=1,im
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22