      PROGRAM DIFFN                                                                                                                 
C     PROGRAM DFFFN(FIELD,      DD,      BETA,      DFIELD,      OUTPUT,)       C2                                                  
C    1        TAPE1=FIELD,TAPE2=DD,TAPE3=BETA,TAPE4=DFIELD,TAPE6=OUTPUT)                                                            
C     ------------------------------------------------------------------        C2                                                  
C                                                                               C2                                                  
C     JAN 05/2005 - B.MIVILLE (MODIFIED FOR DZ INPUT IN 3-D)                    C2                                                  
C     JUL 03/2003 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                         
C     APR 22/2002 - B.MIVILLE (MODIFIED FOR NEW DATA DESCRIPTION FORMAT)                                                            
C     MAR 05/2002 - F.MAJAESS (REVISED FOR "CHAR" KIND RECORDS)                                                                     
C     JUN 06/2001 - B.MIVILLE - ORIGINAL VERSION                                                                                    
C                                                                               C2                                                  
CDIFFN   - CALCULATES VERTICAL OR HORIZONTAL DERIVATIVE OF ANY FIELD    2  1    C1                                                  
C                                                                               C3                                                  
CAUTHOR  - B. MIVILLE                                                           C3                                                  
C                                                                               C3                                                  
CPURPOSE - CALCULATES VERTICAL OR HORIZONTAL DERIVATIVE OF ANY FIELD.           C3                                                  
C                                                                               C3                                                  
CINPUT FILES...                                                                 C3                                                  
C                                                                               C3                                                  
C      FIELD = INPUT FILE OF FIELDS TO BE DERIVED                               C3                                                  
C      DD    = DX,DY OR DZ NEEDED FOR THE DERIVATIVE                            C3                                                  
C      BETA  = HEAVISIDE FUNCTION                                               C3                                                  
C                                                                               C3                                                  
COUTPUT FILE...                                                                 C3                                                  
C                                                                               C3                                                  
C      DFIELD = DERIVATIVE OF FIELD                                             C3                                                  
C                                                                               C3                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
C     * MAXIMUM 2-D GRID SIZE (I+2)*(J+2)=IM*JM --> IJM                                                                             
C     * FOR MAX GRID SIZE OF I*J PLUS ONE MORE ON EACH SIDE.                                                                        
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (IM=771,JM=386,IJM=IM*JM,IJMV=IJM*1)                                                                                
C                                                                                                                                   
      REAL DD(IJM),DFIELD(IJM),FIELD(IJM),BETA(IJM),ID,BETAS(IJM)                                                                   
      REAL FIELD2(IJM),FIELD3(IJM),BETA2(IJM),BETA3(IJM)                                                                            
      REAL BETA2S(IJM),BETA3S(IJM),DD2(IJM)                                                                                         
      INTEGER FLEVEL,FLEVEL2,FLEVEL3,FLEVELP                                                                                        
      INTEGER ILON,ILAT,DLON,DLAT,DLABEL,FLABEL,NLEV,IJ                                                                             
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      COMMON/ICOM/IBUF(8),IDAT(IJMV)                                                                                                
      DATA MAXX/IJMV/                                                                                                               
C-------------------------------------------------------------------                                                                
C                                                                                                                                   
      NF=5                                                                                                                          
      CALL JCLPNT(NF,1,2,3,4,6)                                                                                                     
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
      REWIND 4                                                                                                                      
C                                                                                                                                   
C     *  SET COUNTER TO ZERO                                                                                                        
C                                                                                                                                   
      NR = 0                                                                                                                        
      FLEVELP = 999999                                                                                                              
C                                                                                                                                   
C     *  READ IN THE DX,DY OR DZ. FOR DZ IT OBTAINS THE NLEV                                                                        
C                                                                                                                                   
      CALL GETSET2(2,DD,LEV,NLEV,IBUF,MAXX,OK)                                                                                      
      IF (.NOT.OK) CALL                            XIT('DIFFN',-1)                                                                  
C                                                                                                                                   
C     *  DX, DY AND DZ GRID SIZE (2-D)                                                                                              
C                                                                                                                                   
      NLON=IBUF(5)                                                                                                                  
      NLAT=IBUF(6)                                                                                                                  
      DLABEL=IBUF(3)                                                                                                                
C                                                                                                                                   
C     * REWIND DZ FILE - DZ IS A 3-D FILE                                                                                           
C                                                                                                                                   
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ IN FIELD                                                                                                               
C                                                                                                                                   
 100  CALL GETFLD2 (1,FIELD,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                               
      IF (.NOT.OK)THEN                                                                                                              
         IF (NR.EQ.0) CALL                         XIT('DIFFN',-2)                                                                  
         CALL                                      XIT('DIFFN',0)                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * VERIFY IF THERE IS ANY "LABL" OR "CHAR" KIND RECORDS.                                                                       
C     * PROGRAM WILL EXIT IF IT ENCOUNTERS SUCH A RECORD OR IT                                                                      
C     * IS NOT A GRID.                                                                                                              
C                                                                                                                                   
      IF(IBUF(1).NE.NC4TO8("GRID"))THEN                                                                                             
         IF(IBUF(1).EQ.NC4TO8("LABL").OR.IBUF(1).EQ.NC4TO8("CHAR"))THEN                                                             
            WRITE(6,6020)' *** LABL/CHAR RECORDS ARE NOT ALLOWED ***'                                                               
            CALL                                   XIT('DIFFN',-3)                                                                  
         ELSE                                                                                                                       
            WRITE(6,6020)' *** FIELD LABEL IS NOT GRID ***'                                                                         
            CALL                                   XIT('DIFFN',-4)                                                                  
         ENDIF                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * SAVE LABEL FROM INPUT FIELD                                                                                                 
C                                                                                                                                   
      IBUF2  = IBUF(2)                                                                                                              
      FLABEL = IBUF(3)                                                                                                              
      ILON   = IBUF(5)                                                                                                              
      ILAT   = IBUF(6)                                                                                                              
      IBUF7  = IBUF(7)                                                                                                              
      FLEVEL = IBUF(4)                                                                                                              
      NWORDS = IBUF(5)*IBUF(6)                                                                                                      
C                                                                                                                                   
C     * CHECK DATA                                                                                                                  
C                                                                                                                                   
      IF (NR.EQ.0) THEN                                                                                                             
C                                                                                                                                   
C        * ORIGINAL FIELD LABEL                                                                                                     
C                                                                                                                                   
         FLABELP=IBUF(3)                                                                                                            
C                                                                                                                                   
C        * CHECK IF DX,DY OR DZ AND FIELD ARE THE SAME DIMENSION                                                                    
C                                                                                                                                   
         IF(ILON.NE.NLON.OR.ILAT.NE.NLAT)THEN                                                                                       
            WRITE(6,6020)'INPUT DX OR DY OR DZ ',                                                                                   
     1                   'AND FIELD NOT SAME DIMENSION'                                                                             
            WRITE(6,6010)'DD     : ',NLON,NLAT                                                                                      
            WRITE(6,6010)'FIELDS:  ',ILON,ILAT                                                                                      
            CALL                                   XIT('DIFFN',-5)                                                                  
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * CHECK IF FIELD HAS REPEATED VALUE AT REPEATED LONGITUDE                                                                  
C                                                                                                                                   
         IF(FIELD(1).NE.FIELD(ILON))THEN                                                                                            
            WRITE(6,6020)'FIELD DOES NOT REPEAT AT REPEATED LONGITUDE'                                                              
            WRITE(6,6030)'FIELD(1): ',FIELD(1),                                                                                     
     1           ' FIELD(ILON): ',FIELD(ILON)                                                                                       
            CALL                                   XIT('DIFFN',-6)                                                                  
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * CHECK IF ILON OF FIELD IS ODD MEANING IT HAS REPEATED                                                                    
C        * LONGITUDE                                                                                                                
C                                                                                                                                   
         IODD=MOD(ILON,2)                                                                                                           
         IF(IODD.EQ.0)THEN                                                                                                          
            WRITE(6,6020)'LAST LONGITUDE IS NOT A REPEAT OF FIRST ONE'                                                              
            WRITE(6,6010)'ILON: ',ILON                                                                                              
            CALL                                   XIT('DIFFN',-7)                                                                  
         ENDIF                                                                                                                      
C                                                                                                                                   
      ELSE                                                                                                                          
C                                                                                                                                   
C        * CHECK IF FIELD CHANGED LABEL                                                                                             
C                                                                                                                                   
         IF(FLABEL.NE.FLABELP) THEN                                                                                                 
            WRITE(6,6020)' FIELD NAME HAS CHANGED '                                                                                 
            WRITE(6,6010)'RECORD NUMBER: ',NR+1                                                                                     
            CALL                                   XIT('DIFFN',-8)                                                                  
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * CHECK IF FIELD HAS SAME DIMENSION THROUGHT THE INPUT FILE                                                                
C                                                                                                                                   
         IF((IBUF(5).NE.ILON).OR.(IBUF(6).NE.ILAT))THEN                                                                             
            WRITE(6,6020) ' * DIMENSION OF FIELD HAS CHANGED *'                                                                     
            WRITE(6,6010) 'RECORD NUMBER: ',NR+1                                                                                    
            CALL                                   XIT('DIFFN',-9)                                                                  
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * REWIND BETA AND DD FILES IF NEEDED                                                                                       
C                                                                                                                                   
         IF((FLEVEL.LT.FLEVELP).AND.(NR.GT.0)) THEN                                                                                 
            REWIND 3                                                                                                                
            IF(DLABEL.NE.NC4TO8("  DZ")) REWIND 2                                                                                   
         ENDIF                                                                                                                      
C                                                                                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
C     *  READ IN THE BETA                                                                                                           
C                                                                                                                                   
C     *  NOTE: THE BETAS IN FRONT OF THE DERIVATIVE FORMULA ARE                                                                     
C     *        SHAVED BETAS. ALL THE OTHER ONES ARE EITHER 1 OR 0.                                                                  
C                                                                                                                                   
      IF (FLEVEL.NE.FLEVELP)THEN                                                                                                    
         CALL GETFLD2 (3,BETAS,-1,-1,-1,FLEVEL,IBUF,MAXX,OK)                                                                        
         IF (.NOT.OK)THEN                                                                                                           
            WRITE(6,6020) ' * COULD BE RELATED TO THE LEVELS *'                                                                     
            WRITE(6,6010) ' * FIELD LEVEL: ', FLEVEL                                                                                
            WRITE(6,6010) ' * BETA  LEVEL: ', IBUF(4)                                                                               
            CALL                                   XIT('DIFFN',-10)                                                                 
         ENDIF                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * MAKE SURE BETA HAS SAME DIMENSION AS INPUT FIELD                                                                            
C                                                                                                                                   
      IF(IBUF(5).NE.ILON)CALL                      XIT('DIFFN',-11)                                                                 
      IF(IBUF(6).NE.ILAT)CALL                      XIT('DIFFN',-12)                                                                 
C                                                                                                                                   
C     * KEEP PREVIOUS LEVEL                                                                                                         
C                                                                                                                                   
      FLEVELP=FLEVEL                                                                                                                
C                                                                                                                                   
C     * FIND OUT WHICH FIELD WE HAVE                                                                                                
C                                                                                                                                   
      IF((FLABEL.EQ.NC4TO8("   U")).OR.(FLABEL.EQ.NC4TO8("   V"))                                                                   
     1     .OR.(FLABEL.EQ.NC4TO8("UISO")).OR.                                                                                       
     2         (FLABEL.EQ.NC4TO8("VISO"))    )   THEN                                                                               
         ID=1.E0                                                                                                                    
      ELSEIF((FLABEL.EQ.NC4TO8("TEMP")).OR.                                                                                         
     1       (FLABEL.EQ.NC4TO8("SALT"))      )   THEN                                                                               
         ID=-1.E0                                                                                                                   
      ELSE                                                                                                                          
         WRITE(6,6040) 'FIELD IS NOT A TRACER OR VELOCITY: ',FLABEL                                                                 
         CALL                                      XIT('DIFFN',-13)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * REMOVING THE SHAVED CELL AND MAKING THEM FULL CELL                                                                          
C                                                                                                                                   
      DO 150 L=1,NWORDS                                                                                                             
         IF(BETAS(L).NE.0.E0)THEN                                                                                                   
            BETA(L)=1.0E0                                                                                                           
         ELSE                                                                                                                       
            BETA(L)=0.0E0                                                                                                           
         ENDIF                                                                                                                      
C                                                                                                                                   
 150  CONTINUE                                                                                                                      
C                                                                                                                                   
      IF(DLABEL.EQ.NC4TO8("  DX"))THEN                                                                                              
C                                                                                                                                   
C        * DO THE DERIVATIVE IN DX                                                                                                  
C                                                                                                                                   
         CALL DERIVDX(FIELD,ID,DD,ILON,ILAT,BETAS,BETA,DFIELD)                                                                      
C                                                                                                                                   
C        * OUTPUT RESULTS                                                                                                           
C                                                                                                                                   
         CALL SETLAB(IBUF,NC4TO8("GRID"),IBUF2,FLABEL,FLEVEL,                                                                       
     +                                     ILON,ILAT,IBUF7,1)                                                                       
C                                                                                                                                   
         CALL PUTFLD2(4,DFIELD,IBUF,MAXX)                                                                                           
C                                                                                                                                   
         NR=NR+1                                                                                                                    
C                                                                                                                                   
         GOTO 100                                                                                                                   
C                                                                                                                                   
      ELSEIF(DLABEL.EQ.NC4TO8("  DY"))THEN                                                                                          
C                                                                                                                                   
C        * DO THE DERIVATIVE IN DY                                                                                                  
C                                                                                                                                   
         CALL DERIVDY(FIELD,ID,DD,ILON,ILAT,BETAS,BETA,DFIELD)                                                                      
C                                                                                                                                   
C        * OUTPUT RESULTS                                                                                                           
C                                                                                                                                   
         CALL SETLAB(IBUF,NC4TO8("GRID"),IBUF2,FLABEL,FLEVEL,                                                                       
     +                                     ILON,ILAT,IBUF7,1)                                                                       
C                                                                                                                                   
         CALL PUTFLD2(4,DFIELD,IBUF,MAXX)                                                                                           
C                                                                                                                                   
         NR=NR+1                                                                                                                    
C                                                                                                                                   
         GOTO 100                                                                                                                   
C                                                                                                                                   
      ELSEIF(DLABEL.EQ.NC4TO8("  DZ"))THEN                                                                                          
C                                                                                                                                   
C        * DO DERIVATIVE IN DZ                                                                                                      
C                                                                                                                                   
         K=1                                                                                                                        
         NR=NR+1                                                                                                                    
C                                                                                                                                   
C        * AT THE TOP OF THE OCEAN                                                                                                  
C                                                                                                                                   
 300     IF(K.EQ.1) THEN                                                                                                            
C                                                                                                                                   
C           * READ IN INPUT FIELD                                                                                                   
C                                                                                                                                   
            CALL GETFLD2(1,FIELD2,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                         
            IF (.NOT.OK)THEN                                                                                                        
               CALL                                XIT('DIFFN',0)                                                                   
            ENDIF                                                                                                                   
C                                                                                                                                   
C           * VERIFY IF THERE IS ANY SUPERLABEL.                                                                                    
C           * PROGRAM WILL EXIT IF IT ENCOUNTERS A SUPERLABEL OR IT IS                                                              
C           * NOT A GRID.                                                                                                           
C                                                                                                                                   
            IF(IBUF(1).NE.NC4TO8("GRID"))THEN                                                                                       
               IF(IBUF(1).EQ.NC4TO8("LABL"))THEN                                                                                    
                  WRITE(6,6020)' *** SUPERLABELS ARE NOT ALLOWED ***'                                                               
                  CALL                             XIT('DIFFN',-14)                                                                 
               ELSE                                                                                                                 
                  WRITE(6,6020)' *** FIELD LABEL IS NOT GRID ***'                                                                   
                  CALL                             XIT('DIFFN',-15)                                                                 
               ENDIF                                                                                                                
            ENDIF                                                                                                                   
C                                                                                                                                   
C           * CHECK IF FIELD CHANGED LABEL                                                                                          
C                                                                                                                                   
            IF(IBUF(3).NE.FLABELP) THEN                                                                                             
               WRITE(6,6020)' FIELD NAME HAS CHANGED '                                                                              
               WRITE(6,6010) 'RECORD NUMBER: ',NR+1                                                                                 
               CALL                                XIT('DIFFN',-16)                                                                 
            ENDIF                                                                                                                   
C                                                                                                                                   
C           * CHECK IF FIELD HAS SAME DIMENSION THROUGHT THE INPUT FILE                                                             
C                                                                                                                                   
            IF((IBUF(5).NE.ILON).OR.(IBUF(6).NE.ILAT))THEN                                                                          
               WRITE(6,6020) ' * DIMENSION OF FIELD HAS CHANGED *'                                                                  
               WRITE(6,6010) 'RECORD NUMBER: ',NR+1                                                                                 
               CALL                                XIT('DIFFN',-17)                                                                 
            ENDIF                                                                                                                   
C                                                                                                                                   
C           * SAVE FIELD LABELS                                                                                                     
C                                                                                                                                   
            IBUF2=IBUF(2)                                                                                                           
            IBUF7=IBUF(7)                                                                                                           
            FLEVEL2=IBUF(4)                                                                                                         
C                                                                                                                                   
C           * READ IN DZ FIELD                                                                                                      
C                                                                                                                                   
            CALL GETFLD2(2,DD2,-1,-1,-1,FLEVEL2,IBUF,MAXX,OK)                                                                       
            IF (.NOT.OK)THEN                                                                                                        
               WRITE(6,6020) ' * COULD BE RELATED TO THE LEVELS *'                                                                  
               WRITE(6,6010) ' * FIELD LEVEL: ', FLEVEL2                                                                            
               WRITE(6,'(A,A4)') ' * DZ LEVEL: ', IBUF(4)                                                                           
               CALL                                XIT('DIFFN',-18)                                                                 
            ENDIF                                                                                                                   
C                                                                                                                                   
C           * CHECK DIMENSION OF DZ2                                                                                                
C                                                                                                                                   
            IF((IBUF(5).NE.ILON).OR.(IBUF(6).NE.ILAT))THEN                                                                          
               WRITE(6,6020) ' * DIMENSION OF DZ2 NOT THE SAME *'                                                                   
               WRITE(6,6010) 'RECORD NUMBER: ',NR+1                                                                                 
               CALL                                XIT('DIFFN',-19)                                                                 
            ENDIF                                                                                                                   
C                                                                                                                                   
C           * READ IN BETA FIELD                                                                                                    
C                                                                                                                                   
            CALL GETFLD2(3,BETA2S,-1,-1,-1,FLEVEL2,IBUF,MAXX,OK)                                                                    
            IF (.NOT.OK)THEN                                                                                                        
               WRITE(6,6020) ' * COULD BE RELATED TO THE LEVELS *'                                                                  
               WRITE(6,6010) ' * FIELD LEVEL: ', FLEVEL2                                                                            
               WRITE(6,'(A,A4)') ' * BETA  LEVEL: ', IBUF(4)                                                                        
               CALL                                XIT('DIFFN',-20)                                                                 
            ENDIF                                                                                                                   
C                                                                                                                                   
C           * CHECK DIMENSION OF BETA2                                                                                              
C                                                                                                                                   
            IF((IBUF(5).NE.ILON).OR.(IBUF(6).NE.ILAT))THEN                                                                          
               WRITE(6,6020) ' * DIMENSION OF BETA2 NOT THE SAME *'                                                                 
               WRITE(6,6010) 'RECORD NUMBER: ',NR+1                                                                                 
               CALL                                XIT('DIFFN',-21)                                                                 
            ENDIF                                                                                                                   
C                                                                                                                                   
            DO 302 IJ=1,NWORDS                                                                                                      
C           * REMOVING THE SHAVED CELL AND MAKING THEM FULL CELL                                                                    
               IF(BETA2S(IJ).NE.0.E0) THEN                                                                                          
                  BETA2(IJ)=1.0E0                                                                                                   
               ELSE                                                                                                                 
                  BETA2(IJ)=0.0E0                                                                                                   
               ENDIF                                                                                                                
C                                                                                                                                   
C              * AT SURFACE WE DO ONE SIDED DERIVATIVE USING THE SAME                                                               
C              * METHOD AS IN THE MOM CODE                                                                                          
C                                                                                                                                   
               DFIELD(IJ)=BETAS(IJ)*(BETA2(IJ)*FIELD2(IJ)-                                                                          
     1              BETA(IJ)*FIELD(IJ))/((DD2(IJ)+DD(IJ))/2.E0)                                                                     
 302        CONTINUE                                                                                                                
C                                                                                                                                   
            K=K+1                                                                                                                   
            CALL SETLAB(IBUF,NC4TO8("GRID"),IBUF2,FLABEL,FLEVEL,                                                                    
     +                                        ILON,ILAT,IBUF7,1)                                                                    
C                                                                                                                                   
            CALL PUTFLD2(4,DFIELD,IBUF,MAXX)                                                                                        
C                                                                                                                                   
            NR=NR+1                                                                                                                 
C                                                                                                                                   
         ELSE                                                                                                                       
C                                                                                                                                   
            CALL GETFLD2(1,FIELD3,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                         
            IF (.NOT.OK) CALL                      XIT('DIFFN',0)                                                                   
C                                                                                                                                   
C           * VERIFY IF THERE IS ANY SUPERLABEL.                                                                                    
C           * PROGRAM WILL EXIT IF IT ENCOUNTERS A SUPERLABEL OR IF IT                                                              
C           * IS NOT A GRID.                                                                                                        
C                                                                                                                                   
            IF(IBUF(1).NE.NC4TO8("GRID"))THEN                                                                                       
               IF(IBUF(1).EQ.NC4TO8("LABL"))THEN                                                                                    
                  WRITE(6,6020)' *** SUPERLABELS ARE NOT ALLOWED ***'                                                               
                  CALL                             XIT('DIFFN',-22)                                                                 
               ELSE                                                                                                                 
                  WRITE(6,6020)' *** FIELD LABEL IS NOT GRID ***'                                                                   
                  CALL                             XIT('DIFFN',-23)                                                                 
               ENDIF                                                                                                                
            ENDIF                                                                                                                   
C                                                                                                                                   
C           * CHECK IF FIELD CHANGED LABEL                                                                                          
C                                                                                                                                   
            IF(IBUF(3).NE.FLABELP) THEN                                                                                             
               WRITE(6,6020)' FIELD NAME HAS CHANGED '                                                                              
               WRITE(6,6010) 'RECORD NUMBER: ',NR+1                                                                                 
               CALL                                XIT('DIFFN',-24)                                                                 
            ENDIF                                                                                                                   
C                                                                                                                                   
C           * CHECK IF FIELD HAS SAME DIMENSION THROUGHT THE INPUT FILE                                                             
C                                                                                                                                   
            IF((IBUF(5).NE.ILON).OR.(IBUF(6).NE.ILAT))THEN                                                                          
               WRITE(6,6020) ' * DIMENSION OF FIELD HAS CHANGED *'                                                                  
               WRITE(6,6010) 'RECORD NUMBER: ',NR+1                                                                                 
               CALL                                XIT('DIFFN',-25)                                                                 
            ENDIF                                                                                                                   
C                                                                                                                                   
C           * SAVE FIELD LABEL                                                                                                      
C                                                                                                                                   
            IBUF2=IBUF(2)                                                                                                           
            IBUF7=IBUF(7)                                                                                                           
            FLEVEL3=IBUF(4)                                                                                                         
C                                                                                                                                   
            IF(K.LT.NLEV)THEN                                                                                                       
C                                                                                                                                   
C              * READ IN DZ FIELD                                                                                                   
C                                                                                                                                   
               CALL GETFLD2(2,DD,-1,-1,-1,FLEVEL3,IBUF,MAXX,OK)                                                                     
               IF (.NOT.OK)THEN                                                                                                     
                  WRITE(6,6020) ' * COULD BE RELATED TO THE LEVELS *'                                                               
                  WRITE(6,6010) ' * FIELD LEVEL: ', FLEVEL3                                                                         
                  WRITE(6,'(A,A4)') ' * DZ LEVEL: ', IBUF(4)                                                                        
                  CALL                             XIT('DIFFN',-26)                                                                 
               ENDIF                                                                                                                
C                                                                                                                                   
C              * CHECK DIMENSION OF DZ2                                                                                             
C                                                                                                                                   
               IF((IBUF(5).NE.ILON).OR.(IBUF(6).NE.ILAT))THEN                                                                       
                  WRITE(6,6020) ' * DIMENSION OF DZ2 NOT THE SAME *'                                                                
                  WRITE(6,6010) 'RECORD NUMBER: ',NR+1                                                                              
                  CALL                             XIT('DIFFN',-27)                                                                 
               ENDIF                                                                                                                
C                                                                                                                                   
               CALL GETFLD2(3,BETA3S,-1,-1,-1,FLEVEL3,IBUF,MAXX,OK)                                                                 
               IF (.NOT.OK)THEN                                                                                                     
                  WRITE(6,6020) ' * COULD BE RELATED TO THE LEVELS *'                                                               
                  WRITE(6,6010) ' * FIELD LEVEL: ', FLEVEL3                                                                         
                  WRITE(6,6010) ' * BETA  LEVEL: ', IBUF(4)                                                                         
                  CALL                             XIT('DIFFN',-28)                                                                 
               ENDIF                                                                                                                
C                                                                                                                                   
C           * CHECK IF DIMENSION OF BETA3                                                                                           
C                                                                                                                                   
               IF((IBUF(5).NE.ILON).OR.(IBUF(6).NE.ILAT))THEN                                                                       
                  WRITE(6,6020) ' * DIMENSION OF BETA3 NOT THE SAME *'                                                              
                  WRITE(6,6010) 'RECORD NUMBER: ',NR+1                                                                              
                  CALL                             XIT('DIFFN',-29)                                                                 
               ENDIF                                                                                                                
            ENDIF                                                                                                                   
C                                                                                                                                   
            DO 303 IJ=1,NWORDS                                                                                                      
C                                                                                                                                   
C              * REMOVING THE SHAVED CELL AND MAKING THEM FULL CELL                                                                 
C                                                                                                                                   
               IF(BETA3S(IJ).NE.0.E0) THEN                                                                                          
                  BETA3(IJ)=1.0E0                                                                                                   
               ELSE                                                                                                                 
                  BETA3(IJ)=0.0E0                                                                                                   
               ENDIF                                                                                                                
C                                                                                                                                   
               DFIELD(IJ)=BETA2S(IJ)*(BETA3(IJ)*FIELD3(IJ)+ID*                                                                      
     1              (BETA3(IJ)-BETA(IJ))*FIELD2(IJ)-BETA(IJ)                                                                        
     2              *FIELD(IJ))/(2.E0*DD(IJ))                                                                                       
               FIELD(IJ)=FIELD2(IJ)                                                                                                 
               BETA(IJ)=BETA2(IJ)                                                                                                   
               FIELD2(IJ)=FIELD3(IJ)                                                                                                
               BETA2(IJ)=BETA3(IJ)                                                                                                  
               BETA2S(IJ)=BETA3S(IJ)                                                                                                
 303        CONTINUE                                                                                                                
C                                                                                                                                   
            K=K+1                                                                                                                   
            CALL SETLAB(IBUF,NC4TO8("GRID"),IBUF2,FLABEL,FLEVEL2,                                                                   
     +                                         ILON,ILAT,IBUF7,1)                                                                   
C                                                                                                                                   
            CALL PUTFLD2(4,DFIELD,IBUF,MAXX)                                                                                        
C                                                                                                                                   
            FLEVEL2=FLEVEL3                                                                                                         
C                                                                                                                                   
C           * AT THE BOTTOM OF THE OCEAN WE WANT DT/DZ=0 AND U,V=0.                                                                 
C           * IF THE BOTTOM IS NOT AT K=NLEV IT WILL BE TAKING CARE                                                                 
C           * BY THE BETA.                                                                                                          
C                                                                                                                                   
            IF(K.EQ.NLEV)THEN                                                                                                       
               IF(ID.EQ.1) THEN                                                                                                     
                  DO 304 IJ=1,NWORDS                                                                                                
                     DFIELD(IJ)=BETA2S(IJ)*(-1.E0)*(BETA(IJ)*FIELD2(IJ)+                                                            
     1                    BETA(IJ)*FIELD(IJ))/(2.E0*DD(IJ))                                                                         
 304              CONTINUE                                                                                                          
               ELSE                                                                                                                 
                  DO 305 IJ=1,NWORDS                                                                                                
                     DFIELD(IJ)=0.0E0                                                                                               
 305              CONTINUE                                                                                                          
               ENDIF                                                                                                                
C                                                                                                                                   
               REWIND 2                                                                                                             
               REWIND 3                                                                                                             
C                                                                                                                                   
               CALL SETLAB(IBUF,NC4TO8("GRID"),IBUF2,FLABEL,FLEVEL3,                                                                
     +                                            ILON,ILAT,IBUF7,1)                                                                
C                                                                                                                                   
               CALL PUTFLD2(4,DFIELD,IBUF,MAXX)                                                                                     
C                                                                                                                                   
C              * RETURN TO SEE IF WE HAVE ANOTHER SET OF THE SAME FIELD                                                             
C                                                                                                                                   
               GOTO 100                                                                                                             
C                                                                                                                                   
            ENDIF                                                                                                                   
C                                                                                                                                   
         ENDIF                                                                                                                      
C                                                                                                                                   
         NR=NR+1                                                                                                                    
         GOTO 300                                                                                                                   
C                                                                                                                                   
      ELSE                                                                                                                          
C                                                                                                                                   
         WRITE(6,6020) ' * INPUT DX,DY OR DZ FILE HAS INVALID LABEL *'                                                              
         CALL                                      XIT('DIFFN',-30)                                                                 
C                                                                                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
C----------------------------------------------------------------                                                                   
 6010 FORMAT(A,I8)                                                                                                                  
 6020 FORMAT(A)                                                                                                                     
 6030 FORMAT(A,E12.5,A,E12.5)                                                                                                       
 6040 FORMAT(A,I4)                                                                                                                  
      END                                                                                                                           
