      PROGRAM SOLFLX2                                                                                                               
C     PROGRAM SOLFLX2 (INFIL,       FSO,       INPUT,       OUTPUT,     )       J2                                                  
C    1           TAPE1=INFIL, TAPE2=FSO, TAPE5=INPUT, TAPE6=OUTPUT)                                                                 
C     -------------------------------------------------------------             J2                                                  
C                                                                               J2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       J2                                                  
C     NOV 06/95 - F.MAJAESS (REVISE DEFAULT PACKING DENSITY VALUE)                                                                  
C     DEC 07/94 - F. MAJAESS (ALLOW READING SOLAR CONSTANT)                                                                         
C     JAN 07/93 - M. LAZARE                                                                                                         
C     NOV 19/92 - E. CHAN  (CALL SDET2 INSTEAD OF SDET)                                                                             
C     JUL 13/92 - E. CHAN  (DIMENSION SELECTED VARIABLES AS REAL*8)                                                                 
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     JUL 06/88 - M.LAZARE. - MOVE CALL TO SDET INSIDE LOOP 40.                                                                     
C     MAR 15/88 - M.LAZARE. - ADAPTED FROM SOLFLUX.                                                                                 
C     MAY 13/83 - R.LAPRISE. (ORIGINAL SOLFLUX)                                                                                     
C                                                                               J2                                                  
CSOLFLX2 - RE-COMPUTE THE AVERAGE INCIDENT SOLAR FLUX AT THE TOP OF             J1                                                  
C          THE GCM                                                      1  1 C  J1                                                  
C                                                                               J3                                                  
CAUTHOR  - R.LAPRISE                                                            J3                                                  
C                                                                               J3                                                  
CPURPOSE - RE-COMPUTE THE AVERAGE INCIDENT SOLAR FLUX AT THE TOP OF THE GCM     J3                                                  
C          (FSO) FOR THE TIMESTEPS AND ON THE SAME GRID THAT INFIL IS AVAILABLE.J3                                                  
C          THE OUTPUT FILE REFLECTS THE AVERAGE INCIDENT SOLAR FLUX AT THE TOP  J3                                                  
C          OF THE GCM OVER THE SAVE PERIOD ENDING AT EACH DEFINED TIMESTEP.     J3                                                  
C          NOTE - IT IS ADAPTED FROM SOLFLX WRITTEN BY J.P.BLANCHET.            J3                                                  
C                                                                               J3                                                  
CINPUT FILE...                                                                  J3                                                  
C                                                                               J3                                                  
C      INFIL = CONTAINS FILE RELATED TO RADIATION,I.E. FSG OR ONE LEVEL OF HRS. J3                                                  
C              THERE MUST BE AT LEAST 2 TIMESTEPS IN THE FILE IN ORDER TO       J3                                                  
C              DETERMINE THE START OF THE SAVE PERIOD WHICH CONCLUDES AT NT1.   J3                                                  
C                                                                               J3                                                  
COUTPUT FILE...                                                                 J3                                                  
C                                                                               J3                                                  
C      FSO   = AVERAGE INCIDENT SOLAR FLUX (W M-2).                             J3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               J5                                                  
C      DAY    = INITIAL (JULIAN) DAY OF THE PERIOD                              J5                                                  
C      GMT    = INITIAL G.M.TIME (HR)                                           J5                                                  
C      DELT   = LENGTH OF TIMESTEP OF MODEL RUN (S)                             J5                                                  
C      INCDAY = 1,0 TO INCREMENT THE DECLINATION ANGLE OR NOT                   J5                                                  
C      SOLARC = SOLAR CONSTANT (DEFAULT; 1370 W/M**2)                           J5                                                  
C                                                                               J5                                                  
CEXAMPLE OF INPUT CARD...                                                       J5                                                  
C                                                                               J5                                                  
C*SOLFLX2   182   12      1800    1     1365.                                   J5                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANCK/ FSO(18528)                                                                                                     
C                                                                                                                                   
      COMMON /ICOM/ IBUF(8),IDAT(18528)                                                                                             
C                                                                                                                                   
C     * COMMON BLOCK TO PASS INFORMATION OF EARTH'S ECCENTRIC ORBIT                                                                 
C     * TO SHORTWAVE RADIATION (SHARED WITH SDET2).                                                                                 
C                                                                                                                                   
      COMMON /ECCENT/RRSQ                                                                                                           
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      REAL*8 W(96),WOCS(96),SINL(96),COSL(96),RAD(96)                                                                               
C                                                                                                                                   
      DATA MAXX/18528/                                                                                                              
      DATA SMEAN/1370.E0/, PI/3.141592654E0/                                                                                        
      DATA COSMIN/0.001E0/, LENDAY/86400/                                                                                           
C-----------------------------------------------------------------------                                                            
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ INPUT CARD.                                                                                                            
C                                                                                                                                   
      READ(5,5000,END=901)DAY,GMT,DELT,INCDAY,SOLARC                            J4                                                  
      IF (SOLARC.LE.0.0E0) SOLARC=SMEAN                                                                                             
      WRITE(6,6000)DAY,GMT,DELT,INCDAY,SOLARC                                                                                       
      IF(NINT(DELT).GE.LENDAY) CALL                XIT('SOLFLX2',-1)                                                                
C                                                                                                                                   
C     * SCAN INFIL FOR TIMESTEP INFORMATION.                                                                                        
C                                                                                                                                   
      NSTEPS=0                                                                                                                      
    1 CALL RECGET(1,NC4TO8("GRID"),-1,-1,-1,IBUF,MAXX,OK)                                                                           
      IF(.NOT.OK)THEN                                                                                                               
        IF(NSTEPS.LE.1) CALL                       XIT('SOLFLX2',-2)                                                                
        NT2=IBUF(2)                                                                                                                 
        GO TO 3                                                                                                                     
      ENDIF                                                                                                                         
      NSTEPS=NSTEPS+1                                                                                                               
      IF(NSTEPS.EQ.1)THEN                                                                                                           
        NPACK=MIN(2,IBUF(8))                                                                                                        
        NT1=IBUF(2)                                                                                                                 
        ILG1=IBUF(5)                                                                                                                
        ILAT=IBUF(6)                                                                                                                
      ENDIF                                                                                                                         
      IF(NSTEPS.EQ.2) NT3=IBUF(2)-NT1                                                                                               
      GO TO 1                                                                                                                       
C                                                                                                                                   
C     * PREPARE TO COMPUTE INCIDENT FLUX.                                                                                           
C     * RECOMPUTE TIME PARAMETERS FOR THEORETICAL PREVIOUS SAVE TIME                                                                
C     * STEP AT BEGINNING OF DIAGNOSTIC PERIOD. FIRST TIMESTEP OF ANY                                                               
C     * GCM SIMULATION (KOUNT=0) SHOULD NOT BE DIAGNOSED.                                                                           
C                                                                                                                                   
    3 STEP=DELT/3600.E0                                                                                                             
      NPREV=NT1-NT3                                                                                                                 
      IF(NPREV.LT.0) CALL                          XIT('SOLFLX2',-3)                                                                
      NSECI=INT(DELT)*NT3                                                                                                           
      NSECC=INT(GMT*3600)                                                                                                           
      NSEC=NSECC-NSECI                                                                                                              
      IF(NSEC.LT.0)             THEN                                                                                                
         NSEC=NSEC+LENDAY                                                                                                           
         DAY=DAY-1.E0                                                                                                               
         IF(DAY.LE.0.E0) DAY=DAY+365.E0                                                                                             
      ENDIF                                                                                                                         
      GMT=REAL(NSEC)/3600.E0                                                                                                        
      NSECOLD=NSEC                                                                                                                  
      GMT0=GMT                                                                                                                      
      DAYFIX=DAY                                                                                                                    
      ILG=ILG1-1                                                                                                                    
      NSIZE=ILG1*ILAT                                                                                                               
      ILATH=ILAT/2                                                                                                                  
      RADTIM=2.E0*PI/24.E0                                                                                                          
      RADLON=2.E0*PI/FLOAT(ILG)                                                                                                     
      IBUF(3)=NC4TO8(" FSO")                                                                                                        
      IBUF(8)=NPACK                                                                                                                 
C                                                                                                                                   
C     *** SET GAUSSIAN GRID.                                                                                                        
C                                                                                                                                   
      CALL GAUSSG(ILATH,SINL,W,COSL,RAD,WOCS)                                                                                       
      CALL TRIGL (ILATH,SINL,W,COSL,RAD,WOCS)                                                                                       
      NT=0                                                                                                                          
C                                                                                                                                   
C     *** LOOP ON TIME.                                                                                                             
C                                                                                                                                   
      DO 50 NTIME=NT1,NT2,NT3                                                                                                       
C                                                                                                                                   
      NT=NT+1                                                                                                                       
      IBUF(2)=NTIME                                                                                                                 
C                                                                                                                                   
C     * INITIALIZE ACCUMULATED SUM TO ZERO.                                                                                         
C                                                                                                                                   
      DO 10 N=1,ILG1*ILAT                                                                                                           
        FSO(N)=0.E0                                                                                                                 
   10 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * COMPUTE AVERAGE INCIDENT FLUX OVER SAVE TIME PERIOD.                                                                        
C                                                                                                                                   
      DO 40 ITIME=1,NT3                                                                                                             
C                                                                                                                                   
C       * ADJUST TIME AND CALCULATE SOLAR DECLINATION ANGLE.                                                                        
C                                                                                                                                   
        NSEC=NSECOLD+INT(DELT)                                                                                                      
        IF(NSEC.GE.LENDAY)       THEN                                                                                               
          DAY=DAY+1                                                                                                                 
          NSEC=NSEC-LENDAY                                                                                                          
        ENDIF                                                                                                                       
        GMT=REAL(NSEC)/3600.E0                                                                                                      
        NSECOLD=NSEC                                                                                                                
        IF(DAY.GE.365.E0) DAY=DAY-365.E0                                                                                            
        IF(INCDAY.EQ.0) DAY=DAYFIX                                                                                                  
        CALL SDET2(COSD,SIND,MONTH,DAY)                                                                                             
C                                                                                                                                   
C       * SCALE MEAN (ANNUAL) VALUE OF SOLAR CONSTANT (PASSED THROUGH                                                               
C       * COMMON BLOCK "SWCONS") BY FACTOR ACCOUNTING FOR ECCENTRICITY                                                              
C       * (PASSED THROUGH COMMON BLOCK "ECCENT" - SEE ROUTINE SDET2).                                                               
C                                                                                                                                   
        S=SOLARC*RRSQ                                                                                                               
C                                                                                                                                   
        DO 20 J=1,ILAT                                                                                                              
        DO 20 I=1,ILG1                                                                                                              
          N=I+(J-1)*ILG1                                                                                                            
C                                                                                                                                   
C         * ACCUMULATE INCIDENT FLUX OVER SAVE TIME PERIOD.                                                                         
C                                                                                                                                   
          COSH=-COS(GMT*RADTIM+(I-1)*RADLON)                                                                                        
          COSZ=SINL(J)*SIND+COSL(J)*COSD*COSH                                                                                       
          IF(COSZ.LE.COSMIN) COSZ=0.E0                                                                                              
          FSO(N)=FSO(N)+S*COSZ                                                                                                      
   20   CONTINUE                                                                                                                    
   40 CONTINUE                                                                                                                      
C                                                                                                                                   
C     *** NOW TAKE AVERAGE.                                                                                                         
C                                                                                                                                   
      FNORM=1.E0/FLOAT(NT3)                                                                                                         
      DO 45 N=1,ILG1*ILAT                                                                                                           
        FSO(N)=FSO(N)*FNORM                                                                                                         
   45 CONTINUE                                                                                                                      
C                                                                                                                                   
C     *** PUT DATA IN FILE "FSO".                                                                                                   
C                                                                                                                                   
      CALL PUTFLD2(2,FSO,IBUF,MAXX)                                                                                                 
      IF(NTIME.EQ.NT1 .OR. NTIME.EQ.NT2) WRITE(6,6005)IBUF                                                                          
   50 CONTINUE                                                                                                                      
C                                                                                                                                   
      WRITE(6,6001) NSTEPS,NT                                                                                                       
      WRITE(6,6004) NT1,NT2,NT3                                                                                                     
      EPSILN=0.1E0                                                                                                                  
      GMTM=GMT0-EPSILN                                                                                                              
      GMTP=GMT0+EPSILN                                                                                                              
      WRITE(6,6003) DAYFIX,GMT0,DAY,GMT                                                                                             
      IF(GMT.LT.GMTM.OR.GMT.GT.GMTP) WRITE(6,6002)                                                                                  
C                                                                                                                                   
      CALL                                         XIT('SOLFLX2',0)                                                                 
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
  901 CALL                                         XIT('SOLFLX2',-4)                                                                
C-----------------------------------------------------------------------                                                            
 5000 FORMAT(10X,2F5.0,F10.0,I5,E10.0)                                          J4                                                  
 6000 FORMAT(' DAY,GMT,DELT,INCDAY,SOLARC...',3F10.2,I6,1PE12.4)                                                                    
 6001 FORMAT(1X,I10,' INPUT RECORDS',/,                                                                                             
     1       1X,I10,' OUTPUT RECORDS OF FSO')                                                                                       
 6002 FORMAT(1X,70('*'),/,5X,'THIS PERIOD IS NOT A MULTIPLE OF 24 HOUR',                                                            
     1                    /,1X,70('*'))                                                                                             
 6003 FORMAT(' THE PERIOD IS FROM DAY ',F5.1,' - ',F6.2,'Z TO DAY ',                                                                
     1 F5.1,' - ',F6.2,'Z')                                                                                                         
 6004 FORMAT(' NT1,NT2,NT3 =',3I10)                                                                                                 
 6005 FORMAT(1X,A4,I10,2X,A4,I10,4I6)                                                                                               
      END                                                                                                                           
