      PROGRAM MERCINT                                                                                                               
C     PROGRAM MERCINT(FIELD,       DY,       INTMER,       OUTPUT         )     C2                                                  
C    1          TAPE1=FIELD, TAPE2=DY, TAPE3=INTMER, TAPE6=OUTPUT)                                                                  
C     ------------------------------------------------------------              C2                                                  
C                                                                               C2                                                  
C     JUL 03/2003 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)     C2                                                  
C     MAY 10/2002 - B.MIVILLE (REVISED FOR NEW DATA DESCRIPTION FORMAT)         C2                                                  
C     MAR 05/2002 - F.MAJAESS (REVISED FOR "CHAR" KIND RECORDS)                                                                     
C     MAY 30/2001 - B.MIVILLE - ORIGINAL VERSION                                                                                    
C                                                                               C2                                                  
CMERCINT -  MERIDIONAL CUMULATIVE INTEGRAL OF OCEAN FIELD               2  1    C1                                                  
C                                                                               C3                                                  
CAUTHOR  - B. MIVILLE                                                           C3                                                  
C                                                                               C3                                                  
CPURPOSE - MERIDIONAL INTEGRAL OF OCEAN FIELD FROM SOUTH TO NORTH POLE          C3                                                  
C                                                                               C3                                                  
CINPUT FILE...                                                                  C3                                                  
C                                                                               C3                                                  
C   FIELD = INPUT OCEAN FIELD                                                   C3                                                  
C   DY    = HORIZONTAL GRID CELL HEIGHT                                         C3                                                  
C                                                                               C3                                                  
COUTPUT FILE...                                                                 C3                                                  
C                                                                               C3                                                  
C   INTMER = MERIDIONAL CUMULATIVE INTEGRATION RESULTS                          C3                                                  
C                                                                               C3                                                  
C IMPORTANT: IF THE INPUT FIELD IS 1-D (IBUF(6)=1, NLAT=IBUF(5)) IT EXPECTS     C3                                                  
C            THAT ZONINT HAS BEEN DONE FIRST ON THE FIELD. THE DY USED WILL BE  C3                                                  
C            FOR I=1 AND ALL THE J.                                             C3                                                  
C----------------------------------------------------------------------                                                             
C                                                                                                                                   
C     * MAXIMUM 2D GRID SIZE IM*JM --> IJM                                                                                          
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER(IM=771,JM=386,IJM=IM*JM,IJMV=IJM*1)                                                                                 
C                                                                                                                                   
      LOGICAL OK,SPEC                                                                                                               
      REAL FIELD(IJM),DY(IJM),INTMER(IJM)                                                                                           
      INTEGER FLABEL,NLON,NLON2                                                                                                     
      INTEGER IBUF,IDAT,MAXX                                                                                                        
C                                                                                                                                   
      COMMON/ICOM/IBUF(8),IDAT(IJMV)                                                                                                
      DATA MAXX/IJMV/                                                                                                               
C---------------------------------------------------------------------                                                              
C                                                                                                                                   
      NF=4                                                                                                                          
      CALL JCLPNT(NF,1,2,3,6)                                                                                                       
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
C                                                                                                                                   
C     * READ DY                                                                                                                     
C                                                                                                                                   
      CALL GETFLD2 (2,DY,NC4TO8("GRID"),-1,-1,-1,IBUF,MAXX,OK)                                                                      
      IF (.NOT.OK) CALL                            XIT('MERCINT',-1)                                                                
C                                                                                                                                   
      NLON=IBUF(5)                                                                                                                  
      NLAT=IBUF(6)                                                                                                                  
C                                                                                                                                   
      IF(NLON.GT.IM.OR.NLAT.GT.JM) CALL            XIT('MERCINT',-2)                                                                
C                                                                                                                                   
      NR=0                                                                                                                          
C                                                                                                                                   
C     * READ OCEAN FIELD LEVEL BY LEVEL OR TIME BY TIME                                                                             
C                                                                                                                                   
 100  CALL GETFLD2 (1,FIELD,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                               
      IF (.NOT.OK)THEN                                                                                                              
         IF (NR.EQ.0) CALL                         XIT('MERCINT',-3)                                                                
         WRITE(6,6002)' RECORD NUMBER: ',NR+1                                                                                       
         CALL                                      XIT('MERCINT',0)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * VERIFY IF NLON AND NLAT ARE THE SAME AS IN DY IN AT LEAST                                                                   
C     * ONE DIMENSION (INPUT FIELD COULD BE 1-D)                                                                                    
C                                                                                                                                   
      IF((IBUF(5).NE.NLAT).AND.(IBUF(6).NE.NLAT)) THEN                                                                              
         WRITE(6,6000)' DIMENSION NOT THE SAME BETWEEN DY AND FIELD '                                                               
         WRITE(6,6002)' RECORD NUMBER: ',NR+1                                                                                       
         CALL                                      XIT('MERCINT',-4)                                                                
      ENDIF                                                                                                                         
C                                                                                                                                   
      IF(IBUF(5).EQ.NLON.AND.IBUF(6).NE.NLAT) CALL XIT('MERCINT',-5)                                                                
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 OF A "GRID" OR "ZONL" KIND.                                                                                          
C                                                                                                                                   
      IF((IBUF(1).NE.NC4TO8("GRID")).AND.                                                                                           
     +   (IBUF(1).NE.NC4TO8("ZONL"))     )     THEN                                                                                 
         IF(IBUF(1).EQ.NC4TO8("LABL").OR.IBUF(1).EQ.NC4TO8("CHAR"))THEN                                                             
            WRITE(6,6000)' *** LABL/CHAR RECORDS ARE NOT ALLOWED ***'                                                               
            CALL                                   XIT('MERCINT',-6)                                                                
         ELSE                                                                                                                       
            WRITE(6,6000)' *** FIELD LABEL IS NOT GRID OR ZONL ***'                                                                 
            CALL                                   XIT('MERCINT',-7)                                                                
         ENDIF                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
      IF(NR.EQ.0)THEN                                                                                                               
C                                                                                                                                   
C        * SAVE ORIGINAL FIELD LABEL                                                                                                
C                                                                                                                                   
         FLABEL=IBUF(3)                                                                                                             
C                                                                                                                                   
C        * VERIFY DIMENSION ORDER (2D OR 1D FIELD)                                                                                  
C                                                                                                                                   
C        * IMPORTANT: IF INPUT FIELD IS 1-D (MEANING THAT ZONINT HAS                                                                
C        * PROBABLY BEEN DONE FIRST ON THE FIELD) THE DY USED WILL BE FOR                                                           
C        * I=1 AND ALL THE J.                                                                                                       
C                                                                                                                                   
         IF((IBUF(5).EQ.NLAT).AND.(IBUF(6).EQ.1)) NLON2=1                                                                           
         IF(IBUF(6).EQ.NLAT) NLON2=IBUF(5)                                                                                          
C                                                                                                                                   
      ELSE                                                                                                                          
C                                                                                                                                   
C        * CHECK IF FIELD CHANGED LABEL                                                                                             
C                                                                                                                                   
         IF(IBUF(3).NE.FLABEL) THEN                                                                                                 
            WRITE(6,6000)' FIELD NAME HAS CHANGED '                                                                                 
            WRITE(6,6002)' RECORD NUMBER: ',NR+1                                                                                    
            CALL                                   XIT('MERCINT',-8)                                                                
         ENDIF                                                                                                                      
C                                                                                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
      NWRDS=NLON2*NLAT                                                                                                              
C                                                                                                                                   
C     * VERIFY THAT DIMENSIONS ARE WITHIN THE ARRAY LIMITS                                                                          
C                                                                                                                                   
      IF(NWRDS.GT.IJM) CALL                        XIT('MERCINT',-9)                                                                
C                                                                                                                                   
C     * INITIALIZE                                                                                                                  
C                                                                                                                                   
      DO 110 IJ=1,NWRDS                                                                                                             
         INTMER(IJ) = 0.E0                                                                                                          
 110  CONTINUE                                                                                                                      
C                                                                                                                                   
C     * INTEGRATE FROM SOUTH POLE TO NORTH POLE                                                                                     
C                                                                                                                                   
C     * SINCE WE START FROM THE SOUTH POLE WE ARE ALWAYS OVER LAND                                                                  
C     * ASSUMING THE FIELD HAS BEEN PRE-MULTIPLIED BY BETA THE FIRST                                                                
C     * VALUE OF THE INTEGRAL WILL BE ZERO. THERE IS NO NEED FOR                                                                    
C     * AN EXTRA VALUE AT J=0 TO GIVE NLAT+1 POINTS.                                                                                
C                                                                                                                                   
      DO 122 I=1,NLON2                                                                                                              
         INTMER(I)=FIELD(I) * DY(1)                                                                                                 
         DO 120 J=2,NLAT                                                                                                            
            IJ = (J - 1) * NLON2 + I                                                                                                
            IJDY =  (J - 1) * NLON + I                                                                                              
            IJM1= IJ-NLON2                                                                                                          
            INTMER(IJ) = INTMER(IJM1) + FIELD(IJ) * DY(IJDY)                                                                        
 120     CONTINUE                                                                                                                   
 122  CONTINUE                                                                                                                      
C                                                                                                                                   
      NR=NR+1                                                                                                                       
C                                                                                                                                   
C                                                                                                                                   
C     * WRITE RESULTS TO FILE                                                                                                       
C                                                                                                                                   
      IBUF(1)=NC4TO8("ZONL")                                                                                                        
C                                                                                                                                   
      IF(NLON2.EQ.1)THEN                                                                                                            
         IBUF(5)=NLAT                                                                                                               
         IBUF(6)=1                                                                                                                  
      ELSE                                                                                                                          
         IBUF(5)=NLON2                                                                                                              
         IBUF(6)=NLAT                                                                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      CALL PUTFLD2(3,INTMER,IBUF,MAXX)                                                                                              
C                                                                                                                                   
      GOTO 100                                                                                                                      
C                                                                                                                                   
C---------------------------------------------------------------------                                                              
 6000 FORMAT(A)                                                                                                                     
 6002 FORMAT(A,I5)                                                                                                                  
      END                                                                                                                           
