      PROGRAM GNDALB                                                                                                                
C     PROGRAM GNDALB (AL,      GC,      SNO,      ALFDBK,      OUTPUT,  )       D2                                                  
C    1          TAPE1=AL,TAPE2=GC,TAPE3=SNO,TAPE4=ALFDBK,TAPE6=OUTPUT)                                                              
C     ----------------------------------------------------------------          D2                                                  
C                                                                               D2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       D2                                                  
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     MAY 11/83 - R.LAPRISE.                                                                                                        
C     OCT 21/81 - J.P.BLANCHET                                                                                                      
C                                                                               D2                                                  
CGNDALB  - COMPUTES THE SURFACE ALBEDO INTERACTIVELY WITH SNOW                  D1                                                  
C          ACCUMULATION ON THE GROUND                                   3  1    D1                                                  
C                                                                               D3                                                  
CAUTHOR  - J.P.BLANCHET                                                         D3                                                  
C                                                                               D3                                                  
CPURPOSE - THIS PROGRAM COMPUTES THE SURFACE ALBEDO INTERACTIVELY WITH          D3                                                  
C          SNOW ACCUMULATION ON THE GROUND.                                     D3                                                  
C                                                                               D3                                                  
CINPUT FILES...                                                                 D3                                                  
C                                                                               D3                                                  
C      AL     = BASIC ALBEDO OF THE SURFACE (WITHOUT SNOW)                      D3                                                  
C      GC     = SURFACE TYPE                                                    D3                                                  
C      SNO    = SNOW ACCUMULATION AT EACH SAMPLE STEP (CM)                      D3                                                  
C                                                                               D3                                                  
COUTPUT FILE...                                                                 D3                                                  
C                                                                               D3                                                  
C      ALFDBK = ALBEDO FEED BACK                                                D3                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK                                                                                                                    
C                                                                                                                                   
      COMMON/BLANCK/ A(18528),G(18528),S(18528),AOUT(18528)                                                                         
      COMMON /ICOM/ IBUF(8),IDAT(18528)                                                                                             
C                                                                                                                                   
      DATA MAXX/18528/                                                                                                              
      DATA SNOMAX/10.E0/,ALSNO/0.7E0/                                                                                               
C-----------------------------------------------------------------------                                                            
      NFF=5                                                                                                                         
      CALL JCLPNT(NFF,1,2,3,4,6)                                                                                                    
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
      REWIND 4                                                                                                                      
C                                                                                                                                   
      ICOUNT=0                                                                                                                      
C                                                                                                                                   
C     *** INPUT DATA OF ALBEDO, TYPE OF SURFACE AND SNOW ACCUMULATION.                                                              
C                                                                                                                                   
      CALL GETFLD2(1,A,NC4TO8("GRID"),-1,NC4TO8("  AL"),1,IBUF,MAXX,OK)                                                             
      IF(.NOT.OK) CALL                             XIT('GNDALB',-1)                                                                 
      IF(ICOUNT.EQ.0) WRITE(6,6025) IBUF                                                                                            
      CALL GETFLD2(2,G,NC4TO8("GRID"),-1,NC4TO8("  GC"),1,IBUF,MAXX,OK)                                                             
      IF(.NOT.OK) CALL                             XIT('GNDALB',-2)                                                                 
      IF(ICOUNT.EQ.0) WRITE(6,6025) IBUF                                                                                            
C                                                                                                                                   
  200 CONTINUE                                                                                                                      
C                                                                                                                                   
      CALL GETFLD2(3,S,NC4TO8("GRID"),-1,NC4TO8(" SNO"),1,IBUF,MAXX,OK)                                                             
      IF(.NOT.OK)THEN                                                                                                               
        IF(ICOUNT.EQ.0) CALL                       XIT('GNDALB',-3)                                                                 
        WRITE(6,6000) ICOUNT,IBUF                                                                                                   
        CALL                                       XIT('GNDALB',0)                                                                  
      ENDIF                                                                                                                         
      IF(ICOUNT.EQ.0) WRITE(6,6025) IBUF                                                                                            
C                                                                                                                                   
C     *** SET LABEL FOR OUTPUT FILE.                                                                                                
C                                                                                                                                   
      IBUF(3)=NC4TO8("GALB")                                                                                                        
C                                                                                                                                   
      NSIZE=IBUF(5)*IBUF(6)                                                                                                         
C                                                                                                                                   
C     *** COMPUTE THE EFFECTIVE SURFACE ALBEDO (ALFDB).                                                                             
C                                                                                                                                   
      DO 50 I=1,NSIZE                                                                                                               
      AOUT(I)=0.E0                                                                                                                  
      SNOFAC=MIN(1.E0,SQRT(S(I)/SNOMAX))                                                                                            
      IF(A(I).GT.0.79E0) A(I)=0.82E0                                                                                                
      ALFDB=MAX(A(I),A(I)*(1.E0-SNOFAC)+ALSNO*SNOFAC)                                                                               
      IF(G(I).EQ.0.E0) ALFDB=A(I)                                                                                                   
      IF(G(I).EQ.1.E0) ALFDB=MAX(A(I),ALSNO)                                                                                        
   50 AOUT(I)=ALFDB                                                                                                                 
C                                                                                                                                   
C     *** PUT DATA IN "ALFDBK".                                                                                                     
C                                                                                                                                   
      CALL PUTFLD2(4,AOUT,IBUF,MAXX)                                                                                                
      IF(ICOUNT.EQ.0) WRITE(6,6025) IBUF                                                                                            
C                                                                                                                                   
      ICOUNT=ICOUNT+1                                                                                                               
      GO TO 200                                                                                                                     
C                                                                                                                                   
C-----------------------------------------------------------------------                                                            
 6000 FORMAT(/,/,5X,'NUMBER OF RECORDS IN AND OUT = ',I6,//,5X,A4,I10,2                                                             
     1    A4,I10,4I6,//)                                                                                                            
 6025 FORMAT(' ',A4,I10,2X,A4,I10,4I6)                                                                                              
      END                                                                                                                           
