      PROGRAM MERPSI                                                                                                                
C     PROGRAM MERPSI(      V,        BETA,            DX,          DZ,          D2                                                  
C    1                  ALAT,        PSIO,        PSIPLT,       INPUT,          D2                                                  
C    2                                                         OUTPUT,  )       D2                                                  
C    3               TAPE1=V,  TAPE2=BETA,     TAPE13=DX,   TAPE14=DZ,                                                              
C    4           TAPE15=ALAT, TAPE21=PSIO, TAPE22=PSIPLT, TAPE5=INPUT,                                                              
C    5                                                   TAPE6=OUTPUT)                                                              
C---------------------------------------------------------------------          D2                                                  
C                                                                               D2                                                  
C     JUN 03/09 - F.MAJAESS (INITIALIZE "GBOT" TO GET AROUND XLF OPTIMIZATION   D2                                                  
C                            PROBLEM)                                           D2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     MAY 03/02 - W.G. LEE - OUTPUT PACKING SET TO 1 TO AVOID DIFFERENCES IN                                                        
C                            RESULTS BETWEEN USING MODE=1 AND MODE=2.                                                               
C     MAY 03/02 - W.G. LEE - MAJOR RE-WRITE TO MAKE CONSISTENT WITH DATA                                                            
C                            DESCRIPTION FILE FORMAT AND GRIDO OUTPUT.                                                              
C                            DATA.                                                                                                  
C     NOV 02/01 - W.G. LEE - ORIGINAL VERSION                                                                                       
C                                                                               D2                                                  
CMERPSI  - CALCULATE OCEANIC MERIDIONAL OVERTURNING STREAMFUNCTION      6  2 C  D1                                                  
C                                                                               D3                                                  
CAUTHOR  - W.G. LEE                                                             D3                                                  
C                                                                               D3                                                  
CPURPOSE - PRODUCES VERTICALLY INTEGRATED NORTH-SOUTH MASS TRANSPORT BY         D3                                                  
C          VERTICALLY INTEGRATING V*BETA*DX*DZ AND/OR PRODUCES A FIELD          D3                                                  
C          SUITABLE FOR PLOTTING. CAN PROCESS MULTIPLE SETS OF DATA IN          D3                                                  
C          ONE FILE.                                                            D3                                                  
C                                                                               D3                                                  
CINPUT FILES...                                                                 D3                                                  
C                                                                               D3                                                  
C     V      = MERIDIONAL VELOCITIES (3D FIELD IN METERS PER SECOND)            D3                                                  
C     BETA   = BASIN BETA (3D FIELD: 0=LAND, 1=OCEAN)                           D3                                                  
C     DX     = DX (2-D ARRAY IN METERS)                                         D3                                                  
C     DZ     = DZ (3-D ARRAY IN METERS)                                         D3                                                  
C     ALAT   = LATITUDE (2-D ARRAY IN DEGREES NORTH AND SOUTH OF EQUATOR)       D3                                                  
C     PSIO   = INPUT OVERTURNING STREAMFUNCTION                                 D3                                                  
C              (ONLY INPUT IF MODE=2 - SEE NOTES ON MODE SELECTION BELOW)       D3                                                  
C                                                                               D3                                                  
COUTPUT FILE...                                                                 D3                                                  
C                                                                               D3                                                  
C     PSIO   = ZONAL PROFILES OF MERIDIONAL OVERTURNING STREAMFUNCTION          D3                                                  
C              IN M^3. THE OUTPUT MUST BE DIVIDED BY 10^6 TO CONVERT TO         D3                                                  
C              SVERDRUPS (SV). LAND AND MASKED-OUT AREAS WILL BE GIVEN A        D3                                                  
C              VALUE OF 0.0.                                                    D3                                                  
C              (ONLY OUTPUT IF MODE=1 - SEE NOTES ON MODE SELECTION BELOW)      D3                                                  
C                                                                               D3                                                  
C     PSIPLT = ZONAL PROFILES OF MERIDIONAL OVERTURNING STREAMFUNCTION          D3                                                  
C              IN SVERDRUPS (SV). LAND VALUES WILL BE MASKED OUT WITH THE       D3                                                  
C              SPECIAL VALUE (SPVAL=1.0E38). THE OCEAN POINTS IN A REGION       D3                                                  
C              NOTED BY THE INPUT CARD WILL GIVEN A VALUE OF 1.0E35 SO THAT     D3                                                  
C              THE PROGRAM ZXPLOT CAN PLOT OUT THIS OPTIONALLY MASKED AREA IN   D3                                                  
C              ANOTHER COLOUR.                                                  D3                                                  
C                                                                               D3                                                  
C              IF THE INPUT VELOCITY FIELD IS DIMENSIONED NX*NY*NZ, THEN THE    D3                                                  
C              OUTPUT WILL HAVE NZ+1 FIELDS OF DIMENSION NY*1. THIS OUTPUT      D3                                                  
C              CAN BE PLOTTED USING ZXPLOT.                                     D3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               D5                                                  
C     MODE   = (1,2)   1 = INPUT   V TO CALCULATE BOTH PSI AND PSIPLT           D5                                                  
C                      2 = INPUT PSI TO CALCULATE PSIPLT                        D5                                                  
C     DELAT1 = START LATITUDE FOR REGION TO BE MASKED OUT (IF NEEDED)           D5                                                  
C     DELAT2 = END   LATITUDE FOR REGION TO BE MASKED OUT (IF NEEDED)           D5                                                  
C                    IF YOU DO NOT WANT TO MASK BOTH DELAT1 AND DELAT2 NEED TO  D5                                                  
C                    BE LEFT BLANK.                                             D5                                                  
C                                                                               D5                                                  
C  MODE SELECTION:                                                              D5                                                  
C                                                                               D5                                                  
C     THE REQUIRED INPUT/OUTPUT FILES DEPEND ON THE MODE SELECTION.             D5                                                  
C     THE TABLE BELOW SHOWS WHETHER A FILE IS USED AS AN INPUT (IN),            D5                                                  
C     AN OUTPUT (OUT) OR IF IT ISN'T USED (--).                                 D5                                                  
C                                                                               D5                                                  
C                                                                               D5                                                  
C     MERPSI   V   BETA   DX   DZ   ALAT   PSIO   PSIPLT                        D5                                                  
C                                                                               D5                                                  
C     MODE=1  IN    IN    IN   IN    IN     OUT     OUT                         D5                                                  
C     MODE=2  --    IN    --   IN    IN     IN      OUT                         D5                                                  
C                                                                               D5                                                  
CEXAMPLES OF INPUT CARDS...                                                     D5                                                  
C                                                                               D5                                                  
C*MERPSI      1     -65.0     -35.0                                             D5                                                  
C*MERPSI      2     -65.0     -35.0                                             D5                                                  
C                                                                               D5                                                  
C     BOTH THESE EXAMPLES MASK OUT THE REGION BETWEEN 35S AND 65S               D5                                                  
C                                                                               D5                                                  
C-----------------------------------------------------------------------                                                            
C                                                                                                                                   
C     MAXIMUM 2-D GRID SIZE IMAX X JMAX -> IJMAX                                                                                    
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (IMAX=769,JMAX=384,IJMAX=IMAX*JMAX,IJMAX2=IJMAX*1)                                                                  
      PARAMETER (SPVAL=1.0E38, SPMASK=1.0E35)                                                                                       
C                                                                                                                                   
      REAL      V(IJMAX), BETA(IJMAX)                                                                                               
      REAL     DX(IJMAX),   DZ(IJMAX),   ALAT(IJMAX)                                                                                
      REAL     PSI(JMAX),  PSIO(JMAX),  PSIPLT(JMAX)                                                                                
C                                                                                                                                   
      LOGICAL  OK                                                                                                                   
C                                                                                                                                   
      CHARACTER*10 CDELT1, CDELT2                                                                                                   
C                                                                                                                                   
      INTEGER  MAXX, IDAT, IBUF, I, J,  LMASK(JMAX)                                                                                 
C                                                                                                                                   
      COMMON/ICOM/ IBUF(8),IDAT(IJMAX2)                                                                                             
      DATA MAXX/IJMAX2/                                                                                                             
C                                                                                                                                   
C-----------------------------------------------------------------------                                                            
C     OPEN FILES FOR I/O                                                                                                            
C                                                                                                                                   
      NFF = 9                                                                                                                       
      CALL JCLPNT(NFF,1,2,13,14,15,21,22,5,6)                                                                                       
      REWIND  1                                                                                                                     
      REWIND  2                                                                                                                     
      REWIND 13                                                                                                                     
      REWIND 14                                                                                                                     
      REWIND 15                                                                                                                     
      REWIND 21                                                                                                                     
      REWIND 22                                                                                                                     
C                                                                                                                                   
      NR   = 0                                                                                                                      
C                                                                                                                                   
C                                                                                                                                   
C--------- SECTION 1 ---------------------------------------------------                                                            
C                                                                                                                                   
C     READ IN OPERATING MODE AND ALSO MASKING AREA (IF REQUIRED).                                                                   
C     NO MASKING IS DONE IF THE MASKING AREA VALUES ARE THE SAME OR BLANK.                                                          
C                                                                                                                                   
C       IF  MODE = 1     THEN THE MASKING VALUE = 0.0                                                                               
C       IF  MODE = 2     THEN THE MASKING VALUE = 1.0E35                                                                            
C                                                                                                                                   
C                                                                                                                                   
      READ(5,5010,END=1000) MODE, CDELT1, CDELT2                                D4                                                  
C                                                                                                                                   
C                                                                                                                                   
C--------- SECTION 2 ---------------------------------------------------                                                            
C                                                                                                                                   
C     EXAMINE MODE VALUE FOR CORRECTNESS AND OUTPUT INFO                                                                            
C                                                                                                                                   
      IF (MODE.EQ.1) THEN                                                                                                           
         WRITE(6,6010)                                                                                                              
      ELSEIF (MODE.EQ.2) THEN                                                                                                       
         WRITE(6,6020)                                                                                                              
      ELSE                                                                                                                          
         WRITE(6,6030) MODE                                                                                                         
         CALL                                      XIT('MERPSI',-1)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C--------- SECTION 3 ---------------------------------------------------                                                            
C                                                                                                                                   
C     DETERMINE (IF ANY) REGION NEEDS MASKING                                                                                       
C                                                                                                                                   
      NMASK = 3                                                                                                                     
C                                                                                                                                   
      IF (CDELT1.EQ.'          ')  NMASK = NMASK - 2                                                                                
      IF (CDELT2.EQ.'          ')  NMASK = NMASK - 1                                                                                
C                                                                                                                                   
C                                                                                                                                   
C     TEST VALUE OF NMASK:                                                                                                          
C                          IF NMASK = 0, THEN NO MASKING REQUESTED.                                                                 
C                          IF NMASK = 1, THEN FIRST VALUE MISSING.                                                                  
C                          IF NMASK = 2, THEN SECOND VALUE MISSING.                                                                 
C                          IF NMASK = 3, THEN MASKING REQUESTED.                                                                    
C                                                                                                                                   
      IF (NMASK.EQ.0) THEN                                                                                                          
C                                                                                                                                   
         WRITE(6,6100)                                                                                                              
C                                                                                                                                   
      ELSEIF (NMASK.EQ.1) THEN                                                                                                      
C                                                                                                                                   
         WRITE(6,6110)                                                                                                              
         CALL                                      XIT('MERPSI',-2)                                                                 
C                                                                                                                                   
      ELSEIF (NMASK.EQ.2) THEN                                                                                                      
C                                                                                                                                   
         WRITE(6,6120)                                                                                                              
         CALL                                      XIT('MERPSI',-3)                                                                 
C                                                                                                                                   
      ELSE                                                                                                                          
C                                                                                                                                   
         READ(CDELT1,5020) DELAT1                                                                                                   
         READ(CDELT2,5020) DELAT2                                                                                                   
C                                                                                                                                   
         IF (DELAT1.EQ.DELAT2) THEN                                                                                                 
            NMASK  = 0                                                                                                              
            WRITE(6,6130)                                                                                                           
         ELSE                                                                                                                       
            IF ((DELAT1.GT.90.0E0).OR.(DELAT1.LT.-90.0E0)) THEN                                                                     
               WRITE(6,6140) DELAT1                                                                                                 
               CALL                                XIT('MERPSI',-4)                                                                 
            ENDIF                                                                                                                   
            IF ((DELAT2.GT.90.0E0).OR.(DELAT2.LT.-90.0E0)) THEN                                                                     
               WRITE(6,6140) DELAT2                                                                                                 
               CALL                                XIT('MERPSI',-5)                                                                 
            ENDIF                                                                                                                   
C                                                                                                                                   
            DELATN = MAX(DELAT1,DELAT2)                                                                                             
            DELATS = MIN(DELAT1,DELAT2)                                                                                             
            WRITE(6,6150) DELATN, DELATS                                                                                            
         ENDIF                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C=============================================================                                                                      
C                                                                                                                                   
C                                                                                                                                   
C--------- SECTION 4 ---------------------------------------------------                                                            
C                                                                                                                                   
C     READ IN LATITUDE VALUES (ALAT)                                                                                                
C                                                                                                                                   
      CALL GETFLD2(15,ALAT,NC4TO8("GRID"),0,0,0,IBUF,MAXX,OK)                                                                       
C                                                                                                                                   
      IF (.NOT.OK) THEN                                                                                                             
         WRITE(6,6200)                                                                                                              
         CALL                                      XIT('MERPSI',-6)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
      IMC   = IBUF(5)                                                                                                               
      JMC   = IBUF(6)                                                                                                               
      IMCM1 = IMC - 1                                                                                                               
C                                                                                                                                   
C--------- SECTION 5 ---------------------------------------------------                                                            
C                                                                                                                                   
C     READ IN DX VALUES, IF MODE=1                                                                                                  
C                                                                                                                                   
      IF (MODE.EQ.1) THEN                                                                                                           
C                                                                                                                                   
         CALL GETFLD2(13,DX,NC4TO8("GRID"),0,0,0,IBUF,MAXX,OK)                                                                      
C                                                                                                                                   
         IF (.NOT.OK) THEN                                                                                                          
            WRITE(6,6220)                                                                                                           
            CALL                                   XIT('MERPSI',-7)                                                                 
         ENDIF                                                                                                                      
C                                                                                                                                   
         IF ((IMC.NE.IBUF(5)).OR.(JMC.NE.IBUF(6))) THEN                                                                             
            WRITE(6,6240)                                                                                                           
            CALL                                   XIT('MERPSI',-8)                                                                 
         ENDIF                                                                                                                      
C                                                                                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
C--------- SECTION 6 ---------------------------------------------------                                                            
C                                                                                                                                   
C     TEST TO BE SURE THAT THERE IS BETA DATA.                                                                                      
C                                                                                                                                   
C     THIS IS DONE BEFORE THE MAIN PROCESSING LOOP AS                                                                               
C     AN END-OF-FILE WHEN READING THE BETA DATA FILE IS                                                                             
C     USED TO TRIGGER PROCESSING OF A NEW SET OF INPUT                                                                              
C     (V OR PSIO) DATA.                                                                                                             
C                                                                                                                                   
      CALL GETFLD2(2,BETA,NC4TO8("GRID"),0,0,0,IBUF,MAXX,OK)                                                                        
      IF (.NOT.OK) THEN                                                                                                             
         WRITE(6,6260)                                                                                                              
         CALL                                      XIT('MERPSI',-9)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
      REWIND 2                                                                                                                      
C                                                                                                                                   
C--------- SECTION 7 ---------------------------------------------------                                                            
C                                                                                                                                   
C     BEGIN MAIN LOOP THAT PROCESSES THE INPUT V (MODE=1) OR                                                                        
C     PSIO (MODE=2) DATA.                                                                                                           
C                                                                                                                                   
C     INITIALIZE "GBOT" TO GET AROUND XLF OPTIMIZATION PROBLEM                                                                      
                                                                                                                                    
      GBOT=0.0                                                                                                                      
                                                                                                                                    
      K = 0                                                                                                                         
  100 K = K + 1                                                                                                                     
C                                                                                                                                   
C--------- SECTION 8A ---------------------------------------------------                                                           
C                                                                                                                                   
C     INPUT BETA FOR LEVEL 'K'.                                                                                                     
C     IF AN END-OF-FILE DETECTED, REWIND THE INPUT BETA AND DZ                                                                      
C     FILES AND ASSUME THAT THERE MUST BE MORE THAN ONE SET                                                                         
C     OF INPUT V (MODE 1) OR INPUT PSI (MODE 2) DATA THAT                                                                           
C     NEEDS TO BE PROCESSED.                                                                                                        
C                                                                                                                                   
  110    CALL GETFLD2(2,BETA,NC4TO8("GRID"),0,0,0,IBUF,MAXX,OK)                                                                     
         IF (.NOT.OK) THEN                                                                                                          
            K = 1                                                                                                                   
            REWIND 2                                                                                                                
            REWIND 14                                                                                                               
            GOTO   110                                                                                                              
         ENDIF                                                                                                                      
C                                                                                                                                   
         IF ((IMC.NE.IBUF(5)).OR.(JMC.NE.IBUF(6)))       THEN                                                                       
            WRITE(6,6300)                                                                                                           
            CALL                                   XIT('MERPSI',-10)                                                                
         ENDIF                                                                                                                      
C                                                                                                                                   
         IIBUF4 = IBUF(4)                                                                                                           
C                                                                                                                                   
C--------- SECTION 8B -------------------------------------------------                                                             
C                                                                                                                                   
C     INPUT DZ   FOR LEVEL 'K', SAVE THE IBUF(4) INFO AND THE DEPTH AT THE                                                          
C     BOTTOM OF THE GRIDS TO COMPARE LOCATIONS WITH OTHER INPUT DATA (TO                                                            
C     DETECT MIS-MATCHING DATA).                                                                                                    
C                                                                                                                                   
         CALL GETFLD2(14,DZ,NC4TO8("GRID"),0,0,0,IBUF,MAXX,OK)                                                                      
         IF (.NOT.OK) THEN                                                                                                          
            WRITE(6,6500)                                                                                                           
            CALL                                   XIT('MERPSI',-11)                                                                
         ENDIF                                                                                                                      
C                                                                                                                                   
         IF ((IMC.NE.IBUF(5)).OR.(JMC.NE.IBUF(6))) THEN                                                                             
            WRITE(6,6520)                                                                                                           
            CALL                                   XIT('MERPSI',-12)                                                                
         ENDIF                                                                                                                      
C                                                                                                                                   
         IF (IIBUF4.NE.IBUF(4)) THEN                                                                                                
            WRITE(6,6540)                                                                                                           
            CALL                                   XIT('MERPSI',-13)                                                                
         ENDIF                                                                                                                      
C                                                                                                                                   
         IF (K.EQ.1) THEN                                                                                                           
            GBOT = DZ(1) * 10.E0                                                                                                    
         ELSE                                                                                                                       
            GBOT = GBOT + DZ(1) * 10.E0                                                                                             
         ENDIF                                                                                                                      
C                                                                                                                                   
C                                                                                                                                   
C--------- SECTION 9A -- ONLY FOR MODE 1 -------------------------------                                                            
C                                                                                                                                   
C     INPUT V DATA, BUT ONLY FOR MODE 1                                                                                             
C                                                                                                                                   
         IF (MODE.EQ.1) THEN                                                                                                        
C                                                                                                                                   
            CALL GETFLD2(1,V,NC4TO8("GRID"),0,0,0,IBUF,MAXX,OK)                                                                     
            IF (.NOT.OK) THEN                                                                                                       
               IF (K.EQ.1) THEN                                                                                                     
                  IF (NR .EQ. 0) THEN                                                                                               
                     WRITE(6,6400)                                                                                                  
                    CALL                           XIT('MERPSI',-14)                                                                
                  ELSE                                                                                                              
                     WRITE(6,6000) MODE                                                                                             
                     CALL                          XIT('MERPSI',0)                                                                  
                  ENDIF                                                                                                             
               ELSE                                                                                                                 
                  WRITE(6,6420)                                                                                                     
                  CALL                             XIT('MERPSI',-15)                                                                
               ENDIF                                                                                                                
            ENDIF                                                                                                                   
C                                                                                                                                   
            NR = NR + 1                                                                                                             
C                                                                                                                                   
            IF ((IMC.NE.IBUF(5)).OR.(JMC.NE.IBUF(6))) THEN                                                                          
               WRITE(6,6440)                                                                                                        
               CALL                                XIT('MERPSI',-16)                                                                
            ENDIF                                                                                                                   
C                                                                                                                                   
            IF (IIBUF4.NE.IBUF(4)) THEN                                                                                             
               WRITE(6,6460)                                                                                                        
               CALL                                XIT('MERPSI',-17)                                                                
            ENDIF                                                                                                                   
C                                                                                                                                   
C--------- SECTION 9B -- FOR MODE 1 ONLY -------------------------------                                                            
C                                                                                                                                   
C     ALSO IF MODE=1, DETERMINE THE TRANSPORT CONTRIBUTION FOR EACH                                                                 
C     VERTICAL LEVEL AND LONGITUDE BY INTEGRATING V ALONG LATITUDES.                                                                
C                                                                                                                                   
            DO 220 J   = 1, JMC                                                                                                     
               PSI(J)  = 0.0E0                                                                                                      
               DO 210 I    =  1,IMCM1                                                                                               
                  IJ       =  (J-1)*IMC + I                                                                                         
                  PSI(J)   =  PSI(J)    +                                                                                           
     1                        BETA(IJ)  * V(IJ) * DX(IJ) * DZ(IJ)                                                                   
  210          CONTINUE                                                                                                             
  220       CONTINUE                                                                                                                
C                                                                                                                                   
         ELSEIF (MODE.EQ.2) THEN                                                                                                    
C                                                                                                                                   
C--------- SECTION 10 -- FOR MODE 2 ONLY -------------------------------                                                            
C                                                                                                                                   
C     IF MODE=2, INPUT PSI FOR THIS LEVEL                                                                                           
C                                                                                                                                   
            CALL GETFLD2(21,PSIO,NC4TO8("ZONL"),0,0,0,IBUF,MAXX,OK)                                                                 
C                                                                                                                                   
            IF (.NOT.OK) THEN                                                                                                       
               IF (K.EQ.1) THEN                                                                                                     
                   IF (NR .EQ. 0) THEN                                                                                              
                     WRITE(6,6600)                                                                                                  
                  CALL                             XIT('MERPSI',-18)                                                                
                  ELSE                                                                                                              
                     WRITE(6,6000) MODE                                                                                             
                     CALL                          XIT('MERPSI',0)                                                                  
                  ENDIF                                                                                                             
               ELSE                                                                                                                 
                  WRITE(6,6620)                                                                                                     
                  CALL                             XIT('MERPSI',-19)                                                                
               ENDIF                                                                                                                
            ENDIF                                                                                                                   
C                                                                                                                                   
            NR = NR + 1                                                                                                             
C                                                                                                                                   
            IF (IBUF(6).NE.1) THEN                                                                                                  
               WRITE(6,6640)                                                                                                        
               CALL                                XIT('MERPSI',-20)                                                                
            ENDIF                                                                                                                   
C                                                                                                                                   
            IF (IBUF(5).NE.JMC) THEN                                                                                                
               WRITE(6,6660)                                                                                                        
               CALL                                XIT('MERPSI',-21)                                                                
            ENDIF                                                                                                                   
C                                                                                                                                   
            IF(IBUF(4).NE.INT(GBOT+0.5E0)) THEN                                                                                     
               WRITE(6,6670) IBUF(4), INT(GBOT+0.5E0)                                                                               
               CALL                                XIT('MERPSI',-22)                                                                
            ENDIF                                                                                                                   
C                                                                                                                                   
            IPSIZ = IBUF(4) - INT(DZ(1)*10.0E0/2.0E0 +0.5E0)                                                                        
            IF (IPSIZ.NE.IIBUF4) THEN                                                                                               
               WRITE(6,6680) IPSIZ, IIBUF4                                                                                          
               CALL                                XIT('MERPSI',-23)                                                                
            ENDIF                                                                                                                   
C                                                                                                                                   
         ELSE                                                                                                                       
C                                                                                                                                   
            WRITE(6,6685) MODE                                                                                                      
            CALL                                   XIT('MERPSI',-24)                                                                
C                                                                                                                                   
         ENDIF                                                                                                                      
C                                                                                                                                   
C                                                                                                                                   
C--------- SECTION 11 --------------------------------------------------                                                            
C                                                                                                                                   
C     DETERMINE THE LAND MASK BY SUMMING UP ALL THE BETA                                                                            
C     VALUES ALONG A LATITUDE FOR EACH LONGITUDE.                                                                                   
C                                                                                                                                   
         DO 320 J  = 1, JMC                                                                                                         
            LMASK(J)  = 0                                                                                                           
            DO 300 I    =  1,IMCM1                                                                                                  
               IJ       =  (J-1)*IMC + I                                                                                            
               LMASK(J) =  LMASK(J)  + BETA(IJ)                                                                                     
 300        CONTINUE                                                                                                                
 320     CONTINUE                                                                                                                   
C                                                                                                                                   
C--------- SECTION 12 --------------------------------------------------                                                            
C                                                                                                                                   
C     IF THIS IS THE FIRST LEVEL (K=1), THEN RESET THE DEPTH COUNTER                                                                
C     AND OUTPUT A SURFACE SET OF DATA FOR THE PLOT-READY DATASET                                                                   
C     (PSIPLT) ONLY.                                                                                                                
C                                                                                                                                   
         IF (K.EQ.1) THEN                                                                                                           
C                                                                                                                                   
            DO 400 J = 1,JMC                                                                                                        
               IJ = (1+(J-1)*IMC)                                                                                                   
               IF(MODE.EQ.1) PSIO(J) = 0.0E0                                                                                        
               IF ((NMASK.EQ.3) .AND. (ALAT(IJ).LE.DELATN) .AND.                                                                    
     1            (ALAT(IJ).GE.DELATS) .AND. (LMASK(J).GT.0)) THEN                                                                  
                  PSIPLT(J) = SPMASK                                                                                                
               ELSEIF (LMASK(J).GT.0) THEN                                                                                          
                  PSIPLT(J) = 0.0E0                                                                                                 
               ELSE                                                                                                                 
                  PSIPLT(J) = SPVAL                                                                                                 
               ENDIF                                                                                                                
C                                                                                                                                   
  400       CONTINUE                                                                                                                
C                                                                                                                                   
            ZLEVEL  = 0.0E0                                                                                                         
C                                                                                                                                   
            CALL SETLAB(IBUF,NC4TO8("ZONL"),-1,NC4TO8("PSIO"),                                                                      
     +                                  INT(ZLEVEL),JMC,1,0,1)                                                                      
C                                                                                                                                   
            CALL PUTFLD2(22,PSIPLT,IBUF,MAXX)                                                                                       
C                                                                                                                                   
         ENDIF                                                                                                                      
C                                                                                                                                   
C--------- SECTION 13 --------------------------------------------------                                                            
C                                                                                                                                   
C     IF MODE=1, THEN ADD THE CURRENTLY CALCULATED PSI VALUES TO THE                                                                
C     PREVIOUSLY CALCULATED PSIO VALUES AND OUTPUT RESULTS.                                                                         
C                                                                                                                                   
         ZLEVEL  = ZLEVEL + DZ(1) * 10.0E0                                                                                          
C                                                                                                                                   
         IF (MODE.EQ.1) THEN                                                                                                        
C                                                                                                                                   
            CALL SETLAB(IBUF,NC4TO8("ZONL"),-1,NC4TO8("PSIO"),                                                                      
     +                            INT(ZLEVEL+0.5E0),JMC,1,0,1)                                                                      
C                                                                                                                                   
            DO 500 J = 1, JMC                                                                                                       
               IJ = (1+(J-1)*IMC)                                                                                                   
               IF ((NMASK.EQ.3)       .AND. (ALAT(IJ).LE.DELATN) .AND.                                                              
     1            (ALAT(IJ).GE.DELATS) .AND. (LMASK(J).GT.0)) THEN                                                                  
                  PSIO(J) = 0.0E0                                                                                                   
               ELSEIF (LMASK(J).GT.0) THEN                                                                                          
                  PSIO(J) = PSIO(J) + PSI(J)                                                                                        
               ELSE                                                                                                                 
                  PSIO(J) = 0.0E0                                                                                                   
               ENDIF                                                                                                                
C                                                                                                                                   
  500       CONTINUE                                                                                                                
C                                                                                                                                   
            CALL PUTFLD2(21,PSIO,IBUF,MAXX)                                                                                         
C                                                                                                                                   
         ENDIF                                                                                                                      
C                                                                                                                                   
C--------- SECTION 14 --------------------------------------------------                                                            
C                                                                                                                                   
C     CONVERT OVERTURNING VALUES (PSIO) TO SVERDRUPS, APPLY LAND MASK                                                               
C     AND OPTIONAL MASKING OUT REGION AND OUTPUT PLOT_READY DATA.                                                                   
C                                                                                                                                   
         CALL SETLAB(IBUF,NC4TO8("ZONL"),-1,NC4TO8("PSIO"),                                                                         
     +                         INT(ZLEVEL+0.5E0),JMC,1,0,1)                                                                         
C                                                                                                                                   
         DO 600 J = 1, JMC                                                                                                          
            IJ = (1+(J-1)*IMC)                                                                                                      
            IF ((NMASK.EQ.3)       .AND. (ALAT(IJ).LE.DELATN) .AND.                                                                 
     1         (ALAT(IJ).GE.DELATS) .AND. (LMASK(J).GT.0)) THEN                                                                     
               PSIPLT(J) = SPMASK                                                                                                   
            ELSEIF (LMASK(J).GT.0) THEN                                                                                             
               PSIPLT(J) = PSIO(J) * 1.0E-6                                                                                         
            ELSE                                                                                                                    
               PSIPLT(J) = SPVAL                                                                                                    
            ENDIF                                                                                                                   
C                                                                                                                                   
  600    CONTINUE                                                                                                                   
C                                                                                                                                   
         CALL PUTFLD2(22,PSIPLT,IBUF,MAXX)                                                                                          
C                                                                                                                                   
  999 CONTINUE                                                                                                                      
C                                                                                                                                   
      GOTO 100                                                                                                                      
C                                                                                                                                   
 1000 WRITE(6,6690)                                                                                                                 
      CALL                                         XIT('MERPSI',-25)                                                                
C                                                                                                                                   
C-----------------------------------------------------------------------                                                            
C                                                                                                                                   
 5010 FORMAT(10X,I5,A10,A10)                                                    D4                                                  
 5020 FORMAT(E10.0)                                                                                                                 
C                                                                                                                                   
 6000 FORMAT(' MERPSI: MODE =',I2,' :  END-OF-PROGRAM')                                                                             
 6010 FORMAT(/,'MERPSI:  MODE=1 SELECTED.',                                                                                         
     1       /,'OVERTURNING WILL BE DETERMINED FROM V-VELOCITY ',                                                                   
     2         'FILE. FILE SUITABLE FOR ',                                                                                          
     3       /,'PLOTTING WILL ALSO BE PRODUCED (CONVERT TO ',                                                                       
     4         'SVERDRUPS AND ADD MASKS). ')                                                                                        
 6020 FORMAT(/,'MERPSI:  MODE=2 SELECTED.',                                                                                         
     1       /,'OVERTURNING FILE WILL BE READ AND PLOT FILE WILL ',                                                                 
     2       /,'BE PRODUCED (CONVERT TO SVERDRUPS AND ADD MASKS).')                                                                 
 6030 FORMAT(' MODE =',I4,' IS INVALID.')                                                                                           
C                                                                                                                                   
 6100 FORMAT(' MERPSI : NO REGION MASKING REQUESTED.')                                                                              
C                                                                                                                                   
 6110 FORMAT(' MERPSI: MISSING LATITUDE (1ST) FOR MASKING REGION.')                                                                 
 6120 FORMAT(' MERPSI: MISSING LATITUDE (2ND) FOR MASKING REGION.')                                                                 
 6125 FORMAT(' MERPSI: INPUT LATITUDES HAVE SAME VALUE: ', 2F10.3)                                                                  
 6130 FORMAT(' MERPSI: EQUAL MASK LATITUDES : NO MASKING DONE.')                                                                    
 6140 FORMAT(' MERPSI: ILLEGAL MASKING REGION LATITUDE: ', F10.3)                                                                   
 6150 FORMAT(' MERPSI: MASKING REGION BETWEEN LATITUDES:', 2F10.3)                                                                  
C                                                                                                                                   
 6200 FORMAT(' MERPSI: MISSING LATITUDE FILE.')                                                                                     
 6220 FORMAT(' MERPSI: MISSING DX FILE.')                                                                                           
 6240 FORMAT(' MERPSI: LATITUDE AND DX FILES DIFFER IN SIZE.')                                                                      
 6260 FORMAT(' MERPSI: BETA FILE IS EMPTY!')                                                                                        
C                                                                                                                                   
 6300 FORMAT(' MERPSI: DIMENSION MISMATCH BETWEEN LATITUDES AND BETA.')                                                             
C                                                                                                                                   
 6400 FORMAT(' MERPSI: MISSING V VELOCITY DATA FILE.')                                                                              
 6420 FORMAT(' MERPSI: INSUFFICIENT NUMBER OF V RECORDS.')                                                                          
 6440 FORMAT(' MERPSI: DIMENSION MISMATCH BETWEEN LATITUDES AND V.')                                                                
 6460 FORMAT(' MERPSI: DEPTH MISMATCH BETWEEN BETA AND V')                                                                          
C                                                                                                                                   
 6500 FORMAT(' MERPSI: DIMENSION MISMATCH BETWEEN LATITUDES AND DZ.')                                                               
 6520 FORMAT(' MERPSI: INSUFFICIENT NUMBER OF DZ RECORDS.')                                                                         
 6540 FORMAT(' MERPSI: DEPTH MISMATCH BETWEEN BETA AND DZ')                                                                         
C                                                                                                                                   
 6600 FORMAT(' MERPSI: INPUT PSI FILE EMPTY')                                                                                       
 6620 FORMAT(' MERPSI: INSUFFICIENT NUMBER OF PSIO VALUES')                                                                         
 6640 FORMAT(' MERPSI: N-S DIMENSION FOR PSIO IS INCORRECT')                                                                        
 6660 FORMAT(' MERPSI: DIMENSION FOR PSIO IS INCORRECT')                                                                            
 6670 FORMAT(' MERPSI: DEPTH FOR PSIO NOT VALID: ',I10,I10)                                                                         
 6680 FORMAT(' MERPSI: DEPTH EQUIVALENT FOR PSIO AND BETA',/,                                                                       
     1       '         DO NOT MATCH:',I10,I10)                                                                                      
 6685 FORMAT(' MERPSI: INVALID MODE NUMNBER: ',I5)                                                                                  
 6690 FORMAT(' MERPSI: INPUT CARD EMPTY')                                                                                           
C                                                                                                                                   
      END                                                                                                                           
