
C*--------------------------------------------------------------------*C
C* HISTORIC                                                           *C
C* --------                                                           *C
C*      - Eric Tromeur, NOAA/CREST/CCNY, Jan 2008  		      *C
C*--------------------------------------------------------------------*C


      PROGRAM RELEC                                          

C*====================================================================*C
C* D1 DATA                                                            *C
C*====================================================================*C

C*----------------------------------------------------------*C
C* NUMBERS TO BE DEFINED FOR EACH SPECIFIC REGION AND CLUSTER
C*----------------------------------------------------------*C 
							     !
c     -----------------------------  			     !
c     define clusters					     !
c     -----------------------------			     !
							     !
      PARAMETER (nclusters=8)	         	             !
      PARAMETER (yearstart=1983,yearend=2007)                !
							     ! 
c     -----------------------------			     ! 
c     define location for write out			     !
c     -----------------------------			     !
							     ! 
      PARAMETER (lonw=-1.)				     !  
      PARAMETER (lone=361.)				     !
							     !   D E F I N E   V A R I A B L E S
c     - Tropics						     !   -------------------------------
c       -------						     !
      PARAMETER (latn=15.,lats=-15.,nlat=12,resize=30)	     !      F U N C T I O N    O F
      PARAMETER (loc_code=1)				     !      ----------------------
							     !
c     - Subtropics					     !   S T U D I E D   L O C A T I O N
c       ----------					     !   -------------------------------
c      PARAMETER (latn=35.,lats=-35.,nlat=28,resize=22)	     !
c      PARAMETER (loc_code=2)				     !
							     !
c     - MidlatN						     !
c       -------						     !
c     PARAMETER (latn=65.,lats=30.,nlat=14,resize=48)	     !
c     PARAMETER (loc_code=3)				     !
							     !
c     - MidlatS						     !
c       -------						     !
c     PARAMETER (latn=-30.,lats=-65.,nlat=14,resize=10)	     !
c     PARAMETER (loc_code=4)				     !
							     !
c     nota : nlat=(latn-lats)/2.5			     !
c     ----						     !
c     -----------------------------			     !
							     !
C*----------------------------------------------------------*C
      PARAMETER (nelements=42)
      PARAMETER (firstyear=1983)
      PARAMETER (nyeartot=25,nmon=12,nbdays=31,ninterv=8)

      CHARACTER cmon(nmon)*2,ctime(ninterv)*2,cyear(nyeartot)*4
      DATA cmon /'01','02','03','04','05','06','07','08',
     &'09','10','11','12'/
      DATA ctime /'00','03','06','09','12','15','18','21'/
      DATA cyear /'1983','1984','1985','1986','1987','1988',
     &'1989','1990','1991','1992','1993','1994','1995','1996',
     &'1997','1998','1999','2000','2001','2002','2003','2004',
     &'2005','2006','2007'/
      DATA ndays /31,28,31,30,31,30,31,31,30,31,30,31/
C*----------------------------------------------------------*C

C* NUMBER OF VARIABLES REPORTED IN EACH D1 GRID BOX                     
      PARAMETER     ( MAXVAR = 202 )                                    
C* GRIDS                                                                
      PARAMETER     ( MAXLON = 144 )                                    
      PARAMETER     ( MAXLAT = 72  )                                    
      PARAMETER     ( MAXBOX = 6596 )                                   
C* UNDEFINED VALUE FOR INTEGER VALUES                                   
      PARAMETER     ( IUNDEF = 255 )                                    
C* UNDEFINED VALUE FOR FLOATING POINT VALUES                            
      PARAMETER     ( RUNDEF = -1000.0 )                                
C* D1 RECORD IDENTIFICATION                                             
      COMMON /D1HEAD/ LUND1,IREC,IFILE,IYEAR,MONTH,IDAY,IUTC            
     $     ,LATBEG,LATEND,LONBEG,LONEND,IBXBEG,IBXEND                   
      COMMON /D1DATA/ LAT,NLON,IVAR(MAXVAR,MAXLON),RVAR(MAXVAR,MAXLON)  
      COMMON /D1GRID/ NCELLS(MAXLAT),ICELLS(MAXLAT)                     
      PARAMETER     ( MAXCNT = 255 )                                    
      COMMON/CNTTAB/TMPTAB(0:MAXCNT),TMPVAR(0:MAXCNT),PRETAB(0:MAXCNT), 
     1              RFLTAB(0:MAXCNT),TAUTAB(0:MAXCNT),PRWTAB(0:MAXCNT), 
     2              OZNTAB(0:MAXCNT)                                    
      REAL*4 EQMAP(MAXBOX)                                              
      REAL*4 SQMAP(MAXLON,MAXLAT)
      INTEGER NDAYS(nmon),idx,tot,mmin

      character fnam*37,fdir*34,fnamall*71,fdirfix*22,fdirvar*12
      character ffix*18,fvar*23
      character infile3*64,outfile1*64,outfile2*64
      character cday1*1,cday*2,loc_code1*7,loc_code2*2
      character cmd*64,ver*1,cluschar*2
      real*4 vec(nelements),rd(1)
      integer code,nclus,cluster,ib(1),nmon
      REAL*8 centroid(nclusters,nelements),dist(nclusters)
      integer i,j,m,d,g
      integer clus(MAXLON,nlat,nmon,nbdays,ninterv)
      integer minclus,maxclus,mv1(1),mv2(1),sq11,sq22
      integer LONLIM(2,MAXLON,MAXLAT)                                  

C*====================================================================*C

c
c define location for write out file
c
      IF (loc_code .eq. 1) THEN
         loc_code1="Tropics"
         loc_code2="TR"
      ELSEIF (loc_code .eq. 2) THEN
         loc_code1="ExtTrop"
         loc_code2="ST"
      ELSEIF (loc_code.eq. 3) THEN
         loc_code1="MidlatN"
         loc_code2="MN"
      ELSEIF (loc_code .eq. 4) THEN
         loc_code1="MidlatS"
         loc_code2="MS"
      ENDIF
c
c define number of cluster for file name
c
      IF (nclusters .eq. 4) THEN
         cluschar="04"
      ELSEIF (nclusters .eq. 5) THEN
         cluschar="05"
      ELSEIF (nclusters .eq. 6) THEN
         cluschar="06"
      ELSEIF (nclusters .eq. 7) THEN
         cluschar="07"
      ELSEIF (nclusters .eq. 8) THEN
         cluschar="08"
      ELSEIF (nclusters .eq. 9) THEN
         cluschar="09"
      ENDIF

cc ---------------
cc open ASCII file
cc ---------------
       outfile1='D1.WS.'//loc_code1//'.1.dat'
       OPEN(18,file=outfile1)
cc ---------------

c ----------------
c loop over years 
c ----------------

      DO NY=yearstart-firstyear+1,yearend-firstyear+1

       WRITE(*,*) 'Year ',NY

cc open yearly binary file
cc -----------------------
       outfile2='clus'//cluschar//'.'//loc_code2//'.'//cyear(NY)//'.bin'
       OPEN(19,file=outfile2,form='unformatted',access='direct',
     &       recl=MAXLON*nlat*nmon*nbdays*ninterv*4)
c

cc ------------------------------------
cc ASCII gridded dataset
cc dump to file at the end of each year
cc ------------------------------------

        mmin=1
        IF(ny.eq.1) THEN
               mmin=7
        ENDIF

        mmax=12
        IF(ny.eq.25) THEN
               mmax=6
        ENDIF

        DO m=mmin,mmax
         ndend=ndays(m)
         IF(m.eq.2.and.(ny.eq.2.or.ny.eq.6.or.ny.eq.10.or.ny.eq.14.or.
     + ny.eq.18.or.ny.eq.22)) THEN
        ndend=29
         ENDIF 
         DO d=1,ndend
          DO g=1,8
        IF (loc_code .eq. 1) THEN
         read(18,fmt='(1728i3)')((clus(i,j,m,d,g),i=1,MAXLON),j=1,nlat)
        ELSEIF (loc_code .eq. 2) THEN
         read(18,fmt='(4032i3)')((clus(i,j,m,d,g),i=1,MAXLON),j=1,nlat)
        ELSEIF (loc_code .eq. 3) THEN
         read(18,fmt='(2016i3)')((clus(i,j,m,d,g),i=1,MAXLON),j=1,nlat)
        ELSEIF (loc_code .eq. 4) THEN
         read(18,fmt='(2016i3)')((clus(i,j,m,d,g),i=1,MAXLON),j=1,nlat)
        ENDIF
          ENDDO
         ENDDO
        ENDDO

cc end ASCII file dump
cc ------------------------------------

cc ---------------------
cc Binary file dump
cc ---------------------
      WRITE(19,rec=1)clus
      CLOSE(19)
cc end binary file dump
cc ---------------------

ccc ---------
ccc year loop
ccc ---------
      ENDDO 
ccc ---------
 
      CLOSE(18)

C*--------------------------------------------------------------------*C
C* NORMAL END                                                         *C
C*--------------------------------------------------------------------*C
      END                                                               
