      PROGRAM INITOZ6                                                                                                               
C     PROGRAM INITOZ6 (ICTL,       OZLX,       OZONE,       OUTPUT,     )       I2                                                  
C    1          TAPE99=ICTL, TAPE1=OZLX, TAPE2=OZONE, TAPE6=OUTPUT)                                                                 
C     -------------------------------------------------------------             I2                                                  
C                                                                               I2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       I2                                                  
C     SEP 12/96 - J.DE GRANDPRE (REPLACE CUMULATIVE OZONE CALCULATION           I2                                                  
C                                BY OZONE AMOUNT IN PPMV IN EACH LAYER          I2                                                  
C     JUN 12/96 - F. MAJAESS (PREVIOUS VERSION INITOZ5)                                                                             
C                                                                               I2                                                  
CINITOZ6 - PRODUCES MONTHLY CROSS-SECTIONS OF ZONAL MEAN OZONE                  I1                                                  
C          FOR GCM11                                                    2  1    I1                                                  
C                                                                               I3                                                  
CAUTHORS - J.P.BLANCHET, M.LAZARE, J.DE GRANDPRE                                I3                                                  
C                                                                               I3                                                  
CPURPOSE - INTERPOLATES INITIAL MONTHLY ZONAL CROSS-SECTIONS OF PPMV            I3                                                  
C          OZONE FROM EQUALLY-SPACED LATITUDES TO THE GAUSSIAN GRID,            I3                                                  
C          AND THEN MULTIPLIES BY 1.E-6 TO CONVERT TO PPV. (SUMI DATA)          I3                                                  
C          THE MODEL ROUTINE OZON9 USES THIS RESULT, ALONG WITH THE             I3                                                  
C          SURFACE PRESSURE, TO CALCULATE THE OZONE AMOUNT BETWEEN              I3                                                  
C          FULL MODEL SIGMA SURFACES.                                           I3                                                  
C          IF THE MODEL INITIALIZATION DATE/TIME IS NOT ON A MONTH              I3                                                  
C          BOUNDARY, THE PROGRAM INTERPOLATES BETWEEN ADJACENT MONTH            I3                                                  
C          BOUNDARIES AND STORES THE RESULT ON THE OZONE FILE AS WELL           I3                                                  
C          WITH VALUE OF IDAY IN IBUF(2).                                       I3                                                  
C                                                                               I3                                                  
CINPUT FILES...                                                                 I3                                                  
C                                                                               I3                                                  
C      ICTL  = INITIALIZATION CONTROL DATASET (SEE ICNTRL5).                    I3                                                  
C      OZLX  = MONTHLY LATITUDINAL GLOBAL CROSS-SECTIONS OF OZONE IN            I3                                                  
C              PPMV (ON EQUALLY-SPACED LATITUDES AND A RELATIVELY DENSE         I3                                                  
C              PRESSURE GRID) OBTAINED FROM THE METEOROLOGICAL RESEARCH         I3                                                  
C              REPORT "REFERENCE OZONE MODELS FOR MIDDLE ATMOSPHERE" BY         I3                                                  
C              KITA AND SUMI FROM THE GEOPHYSICAL INSTITUTE, UNIVERSITY         I3                                                  
C              OF TOKYO.                                                        I3                                                  
C                                                                               I3                                                  
COUTPUT FILE...                                                                 I3                                                  
C                                                                               I3                                                  
C      OZONE = MONTHLY GAUSSIAN LATITUDE CROSS-SECTIONS OF OZONE AMOUNT         I3                                                  
C              (PPV) FOR EACH INPUT PRESSURE LEVEL, (ON LEVOZ LEVELS,           I3                                                  
C              WHERE LEVOZ IS THE NUMBER OF PRESSURE LEVELS IN THE              I3                                                  
C              ORIGINAL OZONE DATASET IN THE LLPHYS).                           I3                                                  
C              THERE ARE LEVOZ (=37) PRESSURE LEVELS AND ILAT LATITUDES.        I3                                                  
C---------------------------------------------------------------------------                                                        
C                                                                                                                                   
C                                                                                                                                   
C     *    ILAT = SOUTH - NORTH NUMBER OF GRID POINTS.                                                                              
C     *    P    = VECTOR OF PRESSURE LEVELS IN ORIGINAL OZONE DATA (THE VALUES                                                      
C     *           AT P=2000 WERE ADDED TO EMULATE A "SURFACE" FIELD OF OZONE                                                        
C     *           FOR USE IN INTERPOLATING TO MODEL SIGMA LEVELS BELOW 750 MB).                                                     
C     *           (THEY ACTUALLY ARE A COPY OF THE 750 MB DATA).                                                                    
C     *           THE SIZE OF THIS VECTOR IS 37. ITS VALUES ARE GIVEN IN THE                                                        
C     *           DATASET BELOW FOR REFERENCE, ALTHOUGH THEY ARE NOT USED                                                           
C     *           EXPLICITLY IN THE PROGRAM.                                                                                        
C     *    ALAT = VECTOR OF EQUALLY-SPACED LATITUDES (S.P. TO N.P.) IN ORIGINAL                                                     
C     *           OZONE DATA (THE VALUES AT -90. AND 90. WERE ADDED FOR                                                             
C     *           COMPLETENESS BY COPYING THE ADJACENT VALUES AT -80. AND 80.,                                                      
C     *           RESPECTIVELY).                                                                                                    
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER(LEVOZ=37,NLAT=19)                                                                                                   
      LOGICAL OK                                                                                                                    
      REAL*8 SL(96),CL(96),WL(96),WOSSL(96),RADL(96)                                                                                
      REAL   DLAT(96)                                                                                                               
      REAL ALAT(NLAT),P(LEVOZ),OZZX(NLAT,LEVOZ),O3(96,LEVOZ)                                                                        
      INTEGER NFDM(12),LBL(96)                                                                                                      
C                                                                                                                                   
      COMMON/AOLD/G(65341)                                                                                                          
      COMMON/ANEW/H(96),HM(96),HP(96)                                                                                               
      COMMON/ICOM/IBUF(8),IDAT(65341)                                                                                               
      COMMON/JCOM/JBUF(8),JDAT(65341)                                                                                               
C                                                                                                                                   
      EQUIVALENCE (G(1),OZZX(1,1))                                                                                                  
C                                                                                                                                   
      DATA NFDM/1,32,60,91,121,152,182,213,244,274,305,335/                                                                         
      DATA ALAT/-90.E0,-80.E0,-70.E0,-60.E0,-50.E0,                                                                                 
     &  -40.E0,-30.E0,-20.E0,-10.E0,  0.E0,                                                                                         
     &  10.E0, 20.E0, 30.E0, 40.E0, 50.E0,                                                                                          
     &  60.E0, 70.E0, 80.E0, 90.E0/                                                                                                 
      DATA    P/0.003E0, 0.004E0, 0.005E0, 0.007E0, 0.010E0,                                                                        
     &  0.015E0, 0.020E0, 0.030E0, 0.040E0,                                                                                         
     &  0.050E0, 0.070E0, 0.100E0, 0.150E0, 0.200E0,                                                                                
     &  0.300E0, 0.400E0, 0.500E0, 0.700E0,                                                                                         
     &  1.00E0, 1.50E0, 2.00E0, 3.00E0, 4.00E0,                                                                                     
     &  5.00E0, 7.00E0, 10.0E0, 15.0E0,                                                                                             
     &  20.0E0, 31.0E0, 44.0E0, 88.0E0, 176.E0,                                                                                     
     &  260.E0, 378.E0, 537.E0, 750.E0, 2000.E0/                                                                                    
      DATA MAXX/65341/, MAXLAT/96/                                                                                                  
C-----------------------------------------------------------------------                                                            
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,99,1,2,6)                                                                                                     
C                                                                                                                                   
C     * GET PARAMETERS FROM CONTROL FILE.                                                                                           
C                                                                                                                                   
      REWIND 99                                                                                                                     
      READ(99,END=902) LABL,ILEV,(XXX,L=1,ILEV)                                                                                     
      READ(99,END=903) LABL,IXX,IXX,IXX,ILAT,IXX,IDAY,GMT                                                                           
      WRITE(6,6010)  ILEV,ILAT,IDAY,GMT                                                                                             
C                                                                                                                                   
C     * GET LAT-HGT CROSS-SECTION FOR EACH MONTH (ARRAY NLAT X LEVOZ),                                                              
C     * WHERE NLAT IS THE NUMBER OF EQUALLY-SPACED LATITUDES AND LEVOZ                                                              
C     * IS THE NUMBER OF PRESSURE LEVELS.                                                                                           
C                                                                                                                                   
      DO 290 MONTH=1,12                                                                                                             
      NDAY=NFDM(MONTH)                                                                                                              
      CALL GETFLD2(-1,G,NC4TO8("ZONL"),NDAY,NC4TO8("OZLX"),0,                                                                       
     +                                          IBUF,MAXX,OK)                                                                       
      IF(.NOT.OK) CALL                             XIT('INITOZ6',-1)                                                                
      WRITE(6,6020) IBUF                                                                                                            
      IF(NLAT.NE.IBUF(5)) CALL                     XIT('INITOZ6',-2)                                                                
      IF(LEVOZ.NE.IBUF(6)) CALL                    XIT('INITOZ6',-3)                                                                
C                                                                                                                                   
      IF(ILAT.GT.MAXLAT.OR.NLAT.GT.MAXLAT) CALL    XIT('INITOZ6',-4)                                                                
C                                                                                                                                   
C     * SET DLAT TO GAUSSIAN LATITUDES (DEG).                                                                                       
C                                                                                                                                   
      ILATH=ILAT/2                                                                                                                  
      CALL GAUSSG(ILATH,SL,WL,CL,RADL,WOSSL)                                                                                        
      CALL  TRIGL(ILATH,SL,WL,CL,RADL,WOSSL)                                                                                        
      DO 110 J=1,ILAT                                                                                                               
  110 DLAT(J)=RADL(J)*180.E0/3.14159E0                                                                                              
C                                                                                                                                   
C     * PERFORM INTERPOLATION ON PRESSURE SURFACES FROM EQUALLY-SPACED                                                              
C     * LATITUDES TO GAUSSIAN LATITUDES.                                                                                            
C     * THE ARRAY LBL HOLDS THE POSITION IN THE ARRAY ALAT WHOSE CORRESPONDING                                                      
C     * LATITUDE IS CLOSEST TO, BUT SOUTH OF, (OR POSSIBLY EQUAL TO) THE                                                            
C     * GAUSSIAN LATITUDE DLAT(J); HENCE ONE VALUE FOR EACH GAUSSIAN LATITUDE.                                                      
C     * THE RESULTING ARRAY IS O3(ILAT,LEVOZ).                                                                                      
C                                                                                                                                   
      DO 145 J=1,ILAT                                                                                                               
        IB=0                                                                                                                        
        DO 140 I=1,NLAT                                                                                                             
          IF(DLAT(J).LT.ALAT(I).AND.IB.EQ.0) IB=I                                                                                   
  140   CONTINUE                                                                                                                    
        IF(IB.EQ.0) THEN                                                                                                            
          WRITE(6,6030) DLAT(J)                                                                                                     
          CALL                                     XIT('INITOZ6',-5)                                                                
        ENDIF                                                                                                                       
        LBL(J)=IB-1                                                                                                                 
  145 CONTINUE                                                                                                                      
C                                                                                                                                   
      DO 160 L=1,LEVOZ                                                                                                              
      DO 150 J=1,ILAT                                                                                                               
        K=LBL(J)                                                                                                                    
        CALL LININT(ALAT(K),OZZX(K,L),ALAT(K+1),OZZX(K+1,L),DLAT(J),                                                                
     1              O3(J,L))                                                                                                        
  150 CONTINUE                                                                                                                      
  160 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * EVALUATE THE AMOUNT OF OZONE (IN VOLUME MIXING RATIO).                                                                      
C                                                                                                                                   
      CALL SETLAB(JBUF,NC4TO8("ZONL"),NDAY,NC4TO8("  OZ"),0,ILAT,1,0,1)                                                             
      DO 200 L=1,LEVOZ                                                                                                              
        DO 180 J=1,ILAT                                                                                                             
          H(J)=O3(J,L)*1.0E-6                                                                                                       
  180   CONTINUE                                                                                                                    
        JBUF(4)=L                                                                                                                   
        CALL PUTFLD2(2,H,JBUF,MAXX)                                                                                                 
        WRITE(6,6020) JBUF                                                                                                          
  200 CONTINUE                                                                                                                      
  290 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * ADD EXTRA DATA FOR STARTING DATE (IDAY) OF A NEW MODEL RUN                                                                  
C     * WHICH IS NOT A MONTH BOUNDARY. TO DO THIS, INTERPOLATE BETWEEN                                                              
C     * THE TWO ADJACENT MONTH-BOUNDARY VALUES.                                                                                     
C                                                                                                                                   
      PARTDAY=GMT/24.E0                                                                                                             
      RDAY=FLOAT(IDAY)+PARTDAY                                                                                                      
      LL=0                                                                                                                          
      MM=0                                                                                                                          
      DO 300 N=1,12                                                                                                                 
        IF(IDAY.GE.NFDM(N)) LL=N                                                                                                    
        IF(IDAY.EQ.NFDM(N)) MM=N                                                                                                    
  300 CONTINUE                                                                                                                      
      IF(LL.EQ.0) CALL                             XIT('INITOZ6',-6)                                                                
                                                                                                                                    
      IF(MM.EQ.0) THEN                                                                                                              
                                                                                                                                    
        NDAYM=NFDM(LL)                                                                                                              
        RFDM=FLOAT(NDAYM)                                                                                                           
        IF(LL.LT.12) THEN                                                                                                           
          RFDP=FLOAT(NFDM(LL+1))                                                                                                    
          NDAYP=NFDM(LL+1)                                                                                                          
        ELSE                                                                                                                        
          RFDP=FLOAT(NFDM(1)+365)                                                                                                   
          NDAYP=NFDM(1)                                                                                                             
        ENDIF                                                                                                                       
        WRITE(6,6040) RDAY,NDAYM,NDAYP                                                                                              
C                                                                                                                                   
        DO 500 L=1,LEVOZ                                                                                                            
                                                                                                                                    
          CALL GETFLD2(-2,HM,NC4TO8("ZONL"),NDAYM,NC4TO8("  OZ"),                                                                   
     +                                            L,JBUF,MAXX,OK)                                                                   
          IF(.NOT.OK) CALL                         XIT('INITOZ6',-7)                                                                
          IF(L.EQ.1) THEN                                                                                                           
            WRITE(6,6020) JBUF                                                                                                      
            NPACK=JBUF(8)                                                                                                           
          ENDIF                                                                                                                     
          CALL GETFLD2(-2,HP,NC4TO8("ZONL"),NDAYP,NC4TO8("  OZ"),                                                                   
     +                                            L,JBUF,MAXX,OK)                                                                   
          IF(.NOT.OK) CALL                         XIT('INITOZ6',-8)                                                                
          IF(L.EQ.1) THEN                                                                                                           
            WRITE(6,6020) JBUF                                                                                                      
            NPACK=MIN(NPACK,JBUF(8))                                                                                                
          ENDIF                                                                                                                     
          NWDS=JBUF(5)*JBUF(6)                                                                                                      
          DO 400 I=1,NWDS                                                                                                           
            CALL LININT(RFDM,HM(I),RFDP,HP(I),RDAY,H(I))                                                                            
  400     CONTINUE                                                                                                                  
          JBUF(2)=IDAY                                                                                                              
C                                                                                                                                   
C         * POSITION FILE POINTER TO THE END OF THE FILE AND APPEND DATA.                                                           
C                                                                                                                                   
C         ISTAT=FSEEK(2,0,2)                                                                                                        
  450     READ(2,END=460)                                                                                                           
          GOTO 450                                                                                                                  
  460     BACKSPACE 2                                                                                                               
          JBUF(8)=NPACK                                                                                                             
          CALL PUTFLD2(2,H,JBUF,MAXX)                                                                                               
          WRITE(6,6020) JBUF                                                                                                        
                                                                                                                                    
  500   CONTINUE                                                                                                                    
                                                                                                                                    
      ENDIF                                                                                                                         
C                                                                                                                                   
      CALL                                         XIT('INITOZ6',0)                                                                 
C                                                                                                                                   
C     * E.O.F. ON FILE ICTL.                                                                                                        
C                                                                                                                                   
  902 CALL                                         XIT('INITOZ6',-9)                                                                
  903 CALL                                         XIT('INITOZ6',-10)                                                               
C--------------------------------------------------------------------                                                               
 6010 FORMAT('0 ILEV,ILAT,IDAY,GMT =',3I5,2X,F5.2)                                                                                  
 6020 FORMAT(' ',A4,I10,2X,A4,I10,4I6)                                                                                              
 6030 FORMAT(////,5X,'**** INTERPOLATION ATTEMPTED OUTSIDE THE RANGE OF                                                             
     1THE LATITUDE GRID (-90 TO 90 DEG OF LAT) FOR LAT= ',F6.2,////)                                                                
 6040 FORMAT('0INTERPOLATING FOR RDAY= ',F6.2,' BETWEEN ',I3,' AND ',                                                               
     1           I3,')')                                                                                                            
      END                                                                                                                           
