      PROGRAM VZINTV                                                                                                                
C     PROGRAM VZINTV(FIELD,       DZ,       FIELDZ,       INPUT,                C2                                                  
C    1                                                   OUTPUT,        )       C2                                                  
C    2         TAPE1=FIELD, TAPE2=DZ, TAPE3=FIELDZ, TAPE5=INPUT,                                                                    
C    3                                             TAPE6=OUTPUT)                                                                    
C     ----------------------------------------------------------                C2                                                  
C                                                                               C2                                                  
C     MAY 12/2009 - D.YANG (USE INPUT OCEAN FIELD TIME STAMP IN THE OUTPUT FILE)C2                                                  
C     JAN 17/2007 - F.MAJAESS (CORRECT A TYPO ERROR CAUSING INVALID EXCEPTION)                                                      
C     JUL 03/2003 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                         
C     MAY 07/2002 - B.MIVILLE (REVISED FOR NEW DATA DESCRIPTION FORMAT)                                                             
C     MAR 05/2002 - F.MAJAESS (REVISED FOR "CHAR" KIND RECORDS)                                                                     
C     JUN 07/2001 - B.MIVILLE - ORIGINAL VERSION                                                                                    
C                                                                               C2                                                  
CVZINTV  - VERTICAL INTEGRAL OF OCEAN FIELD BETWEEN SPECIFIC LEVELS     2  1    C1                                                  
C                                                                               C3                                                  
CAUTHOR  - B. MIVILLE                                                           C3                                                  
C                                                                               C3                                                  
CPURPOSE - VERTICAL INTEGRAL OF OCEAN FIELD BETWEEN SPECIFIC LEVELS             C3                                                  
C                                                                               C3                                                  
CINPUT FILES...                                                                 C3                                                  
C                                                                               C3                                                  
C   FIELD = INPUT OCEAN FIELD (PRE-MASKED BY BETA)                              C3                                                  
C   DZ    = VERTICAL GRID CELL HEIGHT (3-D)                                     C3                                                  
C                                                                               C3                                                  
COUTPUT FILE...                                                                 C3                                                  
C                                                                               C3                                                  
C   FIELDZ = VERTICAL INTEGRATION RESULTS                                       C3                                                  
C                                                                               C3                                                  
CINPUT PARAMETERS...                                                            C5                                                  
C                                                                               C5                                                  
C      TOP = TOP LEVEL IN METERS X 10 (AS IN FIELD FILE)                        C5                                                  
C                                                                               C5                                                  
C      BOT = BOTTOM LEVEL IN METER X 10 (AS IN FIELD FILE)                      C5                                                  
C                                                                               C5                                                  
C      NOTE: TOP < BOT                                                          C5                                                  
C            IF YOU WANT TO REPRODUCE THE OUTPUT OF VZINT YOU NEED TO GIVE TO   C5                                                  
C            TOP THE VALUE OF THE TOP OF FIRST GRID BOX (EG. 0) AND GIVE TO     C5                                                  
C            BOT THE VALUE OF THE BOTTOM OF THE BOTTOM GRID BOX ZH (EG. 54350)  C5                                                  
C                                                                               C5                                                  
CEXAMPLE OF INPUT CARD...                                                       C5                                                  
C                                                                               C5                                                  
C*  VZINTV       275     32624                                                  C5                                                  
C                                                                               C5                                                  
C OR TO IMITATE VZINT                                                           C5                                                  
C                                                                               C5                                                  
C*  VZINTV         0     54350                                                  C5                                                  
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                                                                                                                                   
C     * MAXIMUM NUMBER OF LEVELS IS SET IN "KM"                                                                                     
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (IM=771,JM=386,IJM=IM*JM,IJMV=IJM*1)                                                                                
      PARAMETER (KM=200)                                                                                                            
      REAL FIELD(IJM),DZ(IJM),DZS(IJM),FIELDZ(IJM),INTDZ(IJM)                                                                       
      INTEGER NLON,NLAT,LEVEL,NLEV,FLABEL,LEVELP                                                                                    
      INTEGER BOT,TOP,L,IBOT,ITOP,LEV(KM)                                                                                           
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      COMMON/ICOM/IBUF(8),IDAT(IJMV)                                                                                                
      INTEGER NF,NR                                                                                                                 
      DATA MAXX/IJMV/                                                                                                               
C---------------------------------------------------------------------                                                              
C                                                                                                                                   
      NF=5                                                                                                                          
      CALL JCLPNT(NF,1,2,3,5,6)                                                                                                     
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
C     * INPUT FILE NUMBER FOR DZ                                                                                                    
      NDZ=2                                                                                                                         
C                                                                                                                                   
C     * READ TOP AND BOT LEVEL DEPTHS (IN METERS X 10)                                                                              
C                                                                                                                                   
      READ(5,5000,END=900) TOP,BOT                                              C4                                                  
C                                                                                                                                   
      WRITE(6,6020) 'TOP LEVEL: ',TOP,'   BOTTOM LEVEL: ',BOT                                                                       
C                                                                                                                                   
      IF ((BOT.LE.0).OR.(TOP.LT.0)) THEN                                                                                            
         WRITE(6,6030)' * BOT AND/OR TOP HAVE INCORRECT VALUES *'                                                                   
         WRITE(6,6022)' * BOT=',BOT,'   TOP=',TOP                                                                                   
         CALL                                      XIT('VZINTV',-1)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
      IF(TOP.GE.BOT)THEN                                                                                                            
         WRITE(6,6030)' * BOT AND/OR TOP HAVE INCORRECT VALUES *'                                                                   
         WRITE(6,6022)' * BOT=',BOT,'   TOP=',TOP                                                                                   
         CALL                                      XIT('VZINTV',-2)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * FIND NUMBER OF DZ LEVELS                                                                                                    
C                                                                                                                                   
      CALL FILEV(LEV,NLEV,IBUF,NDZ)                                                                                                 
      IF(NLEV.EQ.0.OR.NLEV.GT.KM) CALL             XIT('VZINTV',-3)                                                                 
C                                                                                                                                   
      NR=0                                                                                                                          
      NL=0                                                                                                                          
      LEVELP=0                                                                                                                      
      LEVELPF=999999                                                                                                                
      IBOT=0                                                                                                                        
      ITOP=0                                                                                                                        
C                                                                                                                                   
C     * DO LOOP FOR EACH MULTI LEVEL SET OF DATA                                                                                    
C                                                                                                                                   
 200  CONTINUE                                                                                                                      
C                                                                                                                                   
C     * READ OCEAN FIELD LEVEL BY LEVEL                                                                                             
C                                                                                                                                   
      DO 210 L=1,NLEV                                                                                                               
C                                                                                                                                   
         CALL GETFLD2 (1,FIELD,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                            
         IF (.NOT.OK)THEN                                                                                                           
            IF (NR.EQ.0) CALL                      XIT('VZINTV',-4)                                                                 
            WRITE(6,6015) 'LAST RECORD: ',NR                                                                                        
            WRITE(6,6015) 'LAST LEVEL:  ',LAST_LEV                                                                                  
            CALL                                   XIT('VZINTV',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,6030)' *** LABL/CHAR RECORDS ARE NOT ALLOWED ***'                                                              
             CALL                                  XIT('VZINTV',-5)                                                                 
           ELSE                                                                                                                     
             WRITE(6,6030)' *** FIELD LABEL IS NOT GRID ***'                                                                        
             CALL                                  XIT('VZINTV',-6)                                                                 
           ENDIF                                                                                                                    
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * SAVE FIELD TIME STAMP & LEVEL                                                                                            
C                                                                                                                                   
         ITIME=IBUF(2)                                                                                                              
         LEVEL=IBUF(4)                                                                                                              
C                                                                                                                                   
         LAST_LEV=IBUF(4)                                                                                                           
C                                                                                                                                   
         IF(NR.EQ.0)THEN                                                                                                            
C                                                                                                                                   
C           * SAVE ORIGINAL FIELD LABEL                                                                                             
C                                                                                                                                   
            FLABEL=IBUF(3)                                                                                                          
            NLON=IBUF(5)                                                                                                            
            NLAT=IBUF(6)                                                                                                            
            NWORDS=NLON*NLAT                                                                                                        
C                                                                                                                                   
         ELSE                                                                                                                       
            IF(LEV(L).LT.LEVELP)THEN                                                                                                
               WRITE(6,6030)' * PROBLEMS WITH LEVELS IN FIELD FILE *'                                                               
               CALL                                XIT('VZINTV',-7)                                                                 
            ENDIF                                                                                                                   
C                                                                                                                                   
            IF(LAST_LEV.GT.LEVELPF)THEN                                                                                             
               WRITE(6,6030)' * PROBLEMS WITH LEVELS IN FIELD FILE *'                                                               
               CALL                                XIT('VZINTV',-8)                                                                 
            ENDIF                                                                                                                   
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * CHECK IF FIELD CHANGED LABEL                                                                                             
C                                                                                                                                   
         IF(IBUF(3).NE.FLABEL) THEN                                                                                                 
            WRITE(6,6030)' FIELD NAME HAS CHANGED '                                                                                 
            WRITE(6,6015)' RECORD NUMBER: ',NR+1                                                                                    
            CALL                                   XIT('VZINTV',-9)                                                                 
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * CHECK IF FIELD CHANGED DATE WITHIN SAME SET (FROM 1 TO NLEVEL)                                                           
C                                                                                                                                   
         IF (L.EQ.1) IBUF2=IBUF(2)                                                                                                  
         IF(IBUF(2).NE.IBUF2) THEN                                                                                                  
            WRITE(6,6030)' FIELD DATE HAS CHANGED WITHIN SAME SET '                                                                 
            WRITE(6,6020)' NEW DATE: ',IBUF(2),                                                                                     
     1           '    ORIGINAL DATE: ',IBUF2                                                                                        
            CALL                                   XIT('VZINTV',-10)                                                                
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * CHECK IF FIELD HAS SAME DIMENSION THROUGHT THE INPUT FILE                                                                
C                                                                                                                                   
         IF((IBUF(5).NE.NLON).OR.(IBUF(6).NE.NLAT))THEN                                                                             
            WRITE(6,6030) ' * DIMENSION OF FIELD HAS CHANGED *'                                                                     
            WRITE(6,6015) 'RECORD NUMBER: ',NR+1                                                                                    
            CALL                                   XIT('VZINTV',-11)                                                                
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * READ DZ                                                                                                                  
C                                                                                                                                   
C        * REWIND IF NEEDED                                                                                                         
         IF(LEVELP.EQ.0) THEN                                                                                                       
            NF=-NDZ                                                                                                                 
            DO IJ=1,NWORDS                                                                                                          
               INTDZ(IJ)=0.0E0                                                                                                      
            ENDDO                                                                                                                   
         ELSE                                                                                                                       
            NF=NDZ                                                                                                                  
         ENDIF                                                                                                                      
C                                                                                                                                   
         CALL GETFLD2(NF,DZS,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                              
         IF(.NOT.OK) CALL                          XIT('VZINTV',-12)                                                                
         LEVDZ=IBUF(4)                                                                                                              
         IF(LEVDZ.NE.LEVEL) THEN                                                                                                    
            WRITE(6,6010) LEVEL,LEVDZ                                                                                               
            CALL                                   XIT('VZINTV',-13)                                                                
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * CHECK IF DZS HAS SAME DIMENSION AS INPUT FIELD                                                                           
C                                                                                                                                   
         IF((IBUF(5).NE.NLON).OR.(IBUF(6).NE.NLAT))THEN                                                                             
            WRITE(6,6030) ' * DIMENSION OF DZ DO NOT MATCH FIELD *'                                                                 
            WRITE(6,6015) 'RECORD NUMBER: ',NR+1                                                                                    
            CALL                                   XIT('VZINTV',-14)                                                                
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * VERIFY THAT BOT AND TOP ARE WITHIN LEVEL RANGES                                                                          
C                                                                                                                                   
         IF(L.EQ.1)THEN                                                                                                             
            DO IJ=1,NWORDS                                                                                                          
               MINLEV=LEVDZ-10.E0*DZS(IJ)/2.E0                                                                                      
               IF(TOP.LT.MINLEV) THEN                                                                                               
                  WRITE(6,6030) ' * TOP LEVEL TOO SMALL * '                                                                         
                  CALL                             XIT('VZINTV',-15)                                                                
               ENDIF                                                                                                                
            ENDDO                                                                                                                   
         ELSEIF(L.EQ.NLEV) THEN                                                                                                     
            DO IJ=1,NWORDS                                                                                                          
               MAXLEV=LEVDZ+10*DZS(IJ)/2.E0                                                                                         
               IF(BOT.GT.MAXLEV) THEN                                                                                               
                  WRITE(6,6030) ' * BOT LEVEL TOO BIG * '                                                                           
                  CALL                             XIT('VZINTV',-16)                                                                
               ENDIF                                                                                                                
            ENDDO                                                                                                                   
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * COPY TO DZ, INITIALIZE                                                                                                   
C                                                                                                                                   
         DO 100 IJ=1,NWORDS                                                                                                         
            DZ(IJ)=DZS(IJ)                                                                                                          
 100     CONTINUE                                                                                                                   
C                                                                                                                                   
C        * INITIALIZE TOP AND BOTTOM LEVEL OF VERTICAL GRID CELL                                                                    
C        * HERE WE HAVE TO USE THE ORIGINAL DZ NOT THE MODIFIED ONE                                                                 
C        * SINCE WE WANT TO KNOW WHERE THE TOP AND BOTTOM OF FULL CELLS                                                             
C        * ARE LOCATED                                                                                                              
C                                                                                                                                   
         DO 205 IJ=1,NWORDS                                                                                                         
            LEVELT=LEVDZ-10.E0*DZS(IJ)/2.E0                                                                                         
            LEVELB=LEVDZ+10.E0*DZS(IJ)/2.E0                                                                                         
C                                                                                                                                   
C           * HERE WE INTEGRATE ONLY BETWEEN THE GIVEN LEVELS FROM THE                                                              
C           * INPUT CARDS                                                                                                           
C           *                                                                                                                       
C           * ------------------------------  LEVELT  ---                                                                           
C           *                                          |                                                                            
C           *                               - LEVEL    | DZS                                                                        
C           *                                          |                                                                            
C           * ------------------------------  LEVELB  ---                                                                           
C           *                                                                                                                       
C           *                                                                                                                       
C           * IF LEVELB EQUAL TO TOP WE DO NOT WANT TO USE THAT CELL SINCE                                                          
C           * WE INTEGRATE BETWEEN TOP AND BOT.                                                                                     
C                                                                                                                                   
            IF((LEVELB.GT.TOP).AND.(LEVELT.LT.BOT))THEN                                                                             
C                                                                                                                                   
C              * WE ARE USING NR TO VERIFY IF WE ARE STILL IN THE FIRST SET                                                         
C              * WE ONLY CALCULTE THE MODIFY DZ FOR THE BOTTOM AND TOP ONCE                                                         
C              * IF WE HAVE MULTI SET DATA                                                                                          
C                                                                                                                                   
               IF((NL+1).LE.NLEV)THEN                                                                                               
C                                                                                                                                   
C                 * VERIFY IF WE ARE AT THE TOP OR BOTTOM                                                                           
C                                                                                                                                   
C                 * HERE WE CALCULATE THE NEW THICKNESS                                                                             
C                                                                                                                                   
                  IF((TOP.GE.LEVELT).AND.(TOP.LT.LEVELB)) THEN                                                                      
                     DZ(IJ)=(LEVELB-TOP)/10.E0                                                                                      
                     ITOP=1                                                                                                         
                  ENDIF                                                                                                             
                  IF((BOT.GT.LEVELT).AND.(BOT.LE.LEVELB)) THEN                                                                      
                     DZ(IJ)=(BOT-LEVELT)/10.E0                                                                                      
                     IBOT=1                                                                                                         
                  ENDIF                                                                                                             
C                                                                                                                                   
                  IF(BOT.GT.LEVELB) IBOT=1                                                                                          
C                                                                                                                                   
               ELSE                                                                                                                 
C                                                                                                                                   
C                 * VERIFY IF LEVEL ARE THE SAME IN FOLLOWING SETS                                                                  
C                                                                                                                                   
                  IF(IBUF(4).NE.LEVDZ) THEN                                                                                         
                     WRITE(6,6030)' LEVELS ARE DIFFERENT THAN                                                                       
     1 FIRST SET '                                                                                                                  
                     WRITE(6,6020) 'NEW LEVEL ',IBUF(4),                                                                            
     1                 '    ORIGINAL LEVEL: ',LEVDZ                                                                                 
                     WRITE(6,6015) 'RECORD #: ',NR                                                                                  
                     CALL                          XIT('VZINTV',-17)                                                                
                  ENDIF                                                                                                             
C                                                                                                                                   
               ENDIF                                                                                                                
C                                                                                                                                   
C              * VERIFY THAT IT FOUND A NEW DZ FOR THE BOTTOM AND TOP LAYER                                                         
C                                                                                                                                   
               IF((NL+1).EQ.NLEV)THEN                                                                                               
                  IF((ITOP.EQ.0).OR.(IBOT.EQ.0)) THEN                                                                               
C                                                                                                                                   
                     WRITE(6,6030)' * BOT AND/OR TOP HAVE                                                                           
     1                    INCORRECT VALUES *'                                                                                       
                     WRITE(6,6020)' * BOT=',BOT,'   TOP=',TOP                                                                       
                     CALL                          XIT('VZINTV',-18)                                                                
                  ENDIF                                                                                                             
               ENDIF                                                                                                                
C                                                                                                                                   
C              * INITIALIZE AND INTEGRATE                                                                                           
C                                                                                                                                   
               IF(LEVELP.EQ.0)THEN                                                                                                  
                  INTDZ(IJ) = 0.0E0                                                                                                 
                  INTDZ(IJ) = FIELD(IJ) * DZ(IJ)                                                                                    
               ELSE                                                                                                                 
                  INTDZ(IJ) = INTDZ(IJ) + FIELD(IJ) * DZ(IJ)                                                                        
               ENDIF                                                                                                                
C                                                                                                                                   
            ENDIF                                                                                                                   
C                                                                                                                                   
 205     CONTINUE                                                                                                                   
C                                                                                                                                   
         NR=NR+1                                                                                                                    
         NL=NL+1                                                                                                                    
         LEVELP=LEVDZ                                                                                                               
C                                                                                                                                   
 210  CONTINUE                                                                                                                      
C                                                                                                                                   
      LEVELPF=LEVELP                                                                                                                
      LEVELP=0                                                                                                                      
      NL=0                                                                                                                          
C                                                                                                                                   
C     * WRITE RESULTS TO FILE                                                                                                       
C                                                                                                                                   
      IBUF(2)=ITIME                                                                                                                 
      IBUF(3)=FLABEL                                                                                                                
      IBUF(4)=1                                                                                                                     
      IBUF(5)=NLON                                                                                                                  
      IBUF(6)=NLAT                                                                                                                  
      IBUF(8)=1                                                                                                                     
C                                                                                                                                   
      CALL PUTFLD2(3,INTDZ,IBUF,MAXX)                                                                                               
C                                                                                                                                   
      GOTO 200                                                                                                                      
C                                                                                                                                   
 900  CALL                                         XIT('VZINTV',-19)                                                                
C---------------------------------------------------------------------                                                              
 5000 FORMAT(10X,2I10)                                                          C4                                                  
 6010  FORMAT('LEVELS DO NOT MATCH. FIELD: ',I6,'  DZ: ',I6)                                                                        
 6015 FORMAT(A,I8)                                                                                                                  
 6020 FORMAT(A,I8,A,I8)                                                                                                             
 6022 FORMAT(A,I8,A,I8,A,I8)                                                                                                        
 6025 FORMAT(A,2I8)                                                                                                                 
 6030 FORMAT(A)                                                                                                                     
      END                                                                                                                           
