C2SURF
C
C An example of an external analysis function for VIS-5D version 4.0
C
C The parts in uppercase should be the same for all analysis functions,
C while the parts in lowercase are specific to this example (except
C comments).


C All VIS-5D analysis functions must be named USERFUNC and take the
C following arguments:
C
C   Output arguments:
C     OUTGRID - This is the array which the function computes
C     OUTNL - Number of levels in computed OUTGRID
C     OUTLOWLEV - Lowest level in computed OUTGRID
C
C   Input arguments:
C     INGRID -  Array of all 3-D grids for each available parameter
C     NR,NC - Number of rows and columns in all 3-D grids
C     NL - number of levels in *each* variable's 3-D grid.
C          An array of NL values is needed because each variable's
C          grid can contain a different number of levels.  However,
C          it's often the case that the number of grid levels is
C          the same for all grids.
C     LOWLEV - lowest level in *each* variable's 3-D grid.
C     MAXNL - maximum number of grid levels (max value in NL() array)
C     NVARS - number of physical variables
C     NAMES - names of each parameter
C     DATE - date of this grid in days since January 1, 1900
C            (use the IYYDDD function to convert to YYDDD format)
C     TIME - time of this grid in seconds since midnight
C            (use the IHMS function to convert to HHMMSS format)
C     PROJECTION - which map projection is being used.  See the README
C            file's sections on using the map projection and the
C            v5dCreate function to learn how this parameter and PROJ_ARGS
C            are used.
C     PROJ_ARGS - projection-specific parameters  (See README file)
C     VERTICAL - which vertical coordinate system is being used.  Again,
C            see the README file's documentation on v5dCreate to see how
C            this parameter and VERT_ARGS are used.
C     VERT_ARGS - vertical coordinate system specific parameters.
C
C Here is the row, column, level arrangement of the OUTGRID (and INGRID)
C arrays:
C     OUTGRID(1, 1, 1 ) = North-west-bottom corner
C     OUTGRID(NR,1, 1 ) = South-west-bottom corner
C     OUTGRID(1, NC,1 ) = North-east-bottom corner
C     OUTGRID(NR,NC,1 ) = South-east-bottom corner
C     OUTGRID(1, 1, NL) = North-west-top corner
C     OUTGRID(NR,1, NL) = South-west-top corner
C     OUTGRID(1, NC,NL) = North-east-top corner
C     OUTGRID(NR,NC,NL) = South-east-top corner
C
C The function should return 0 if it completed successfully or C a
C non-zero value if there was an error.
C
C
      INTEGER FUNCTION USERFUNC( OUTGRID, OUTNL, OUTLOWLEV,
     *                           INGRID, NR, NC, NL, LOWLEV, MAXNL,
     *                           NVARS, NAMES,
     *                           DATE, TIME,
     *                           PROJECTION, PROJ_ARGS,
     *                           VERTICAL, VERT_ARGS )
C     ARGUMENTS:
	implicit none
      INTEGER NVARS
      INTEGER NR, NC, NL(NVARS), LOWLEV(NVARS), MAXNL
      REAL OUTGRID(NR,NC,MAXNL)
      INTEGER OUTNL, OUTLOWLEV
      REAL INGRID(NR,NC,MAXNL,NVARS),zpo(nc,100),zp(nc,100)
      CHARACTER*8 NAMES(NVARS)
      INTEGER DATE, TIME
      INTEGER PROJECTION
      REAL PROJ_ARGS(*)
      INTEGER VERTICAL,IYYDDD,IHMS
      REAL VERT_ARGS(*),zpmin,zpmax,p(maxnl),pf(100),p1,p2
	character*20 name
	character*6 chartime
	character*6 chardate
	character*4 charlev

C     LOCAL VARS:
      integer iv, ir, ic, il, ifi,iln,numl,lev,leng,ilf,il1,il2,
     $        ilf_filt,ic_filt,inames,numnames,nfilt
      
C DAYS WIHIN THE 12 MONTHS (FOR NORMAL YEARS)
       Integer days_month(12),iyy,imm,idd,iyymmdd,julian
       Data days_month / 31,28,31,30,31,30,31,31,30,31,30,31 /          
          
C     Specify number of levels in OUTGRID
      OUTNL = MAXNL
      OUTLOWLEV = 0
C     look for variables
	do iln=1,maxnl
       p(iln)=1012.5*exp(vert_args(iln)/-7.2)
       enddo
	open(17,file='2SURFr.txt')
C Llegim numero de variables que volem passar a surfer
        read(17,*) numnames	
	Do 444 inames=1,numnames
	read(17,*)

C Llegim el nom de la variable que volem passar a surfer
	read(17,'(A)')name
	
C Llegim nfilt: Rows and Columns on either side of center to apply matrix smooth 
C (average method with weight of matrix center = 2):	
	read(17,*) nfilt	
	
C Cercam la longitud de name
	if (name(2:2).eq.'"') then
	leng=1	 
	else if (name(3:3).eq.'"') then
	leng=2	 
	else if (name(4:4).eq.'"') then
	leng=3	 
	else if (name(5:5).eq.'"') then
	leng=4	 
	else if (name(6:6).eq.'"') then
	leng=5	 
	else if (name(7:7).eq.'"') then
	leng=6	 
	else if (name(8:8).eq.'"') then
	leng=7	 
	else if (name(9:9).eq.'"') then
	leng=8	 
	else if (name(10:10).eq.'"') then
	leng=9	 
	endif	 
	do iv=1,nvars
	if (names(iv).eq.name(2:leng)) then
	ifi=iv
	endif
	enddo
	print*,'Variable: ',names(ifi),'nfilt=',nfilt
	read(17,'(I2)')numl
        do 333 iln=1,numl
        read(17,'(I4)')ir
	print*,'Row:',ir
	
	do 3000 ilf=1,100
	 pf(ilf)=p(1)+(ilf-1)*(p(maxnl)-p(1))/99.	
         do il=1,maxnl-1
          If (p(il).Ge.pf(ilf).And.p(il+1).Le.pf(ilf)) Then
	   il1=il 
	   p1=p(il)
	   il2=il+1
	   p2=p(il+1)
	   Goto 20
	  Endif
20        Continue	  
         enddo 
	 do ic=1,nc
	  zpo(ic,ilf)=ingrid(ir,ic,il1,ifi)+(pf(ilf)-p1)*
     $    (ingrid(ir,ic,il2,ifi)-ingrid(ir,ic,il1,ifi))/(p2-p1)	  
          zp(ic,ilf)=1.70141E+038
	 enddo  
3000    continue	  

        zpmin=10000000
	zpmax=-10000000	
	do 5000 ilf=1+nfilt,100-nfilt
	do 5000 ic=1+nfilt,nc-nfilt
	  zp(ic,ilf)=zpo(ic,ilf) 
	  do ilf_filt=ilf-nfilt,ilf+nfilt
	  do ic_filt=ic-nfilt,ic+nfilt	  	   	
	    zp(ic,ilf)=zp(ic,ilf)+zpo(ic_filt,ilf_filt)
          enddo
	  enddo
	  zp(ic,ilf)=zp(ic,ilf)/((2.*nfilt+1)*(2.*nfilt+1)+1.)
	  if (zp(ic,ilf).lt.zpmin) zpmin=zp(ic,ilf)
	  if (zp(ic,ilf).gt.zpmax) zpmax=zp(ic,ilf)	 	
5000    continue
	

C Cercam la longitud de ir	 
	 if (ir.ge.1000) write (charlev,'(I4)')ir
	 if (ir.lt.1000.and.ir.ge.100) write (charlev,'(A,I3)')'0',ir
	 if (ir.lt.100.and.ir.ge.10) write (charlev,'(A,I2)')'00',ir
	 if (ir.lt.10.and.ir.ge.1) write (charlev,'(A,I1)')'000',ir
	
	 iyy=Mod(IYYDDD(date),100000)/1000
	 imm=0
	 idd=0
	 If (Mod(iyy-1964,4).Eq.0) days_month(2)=29
	 julian=Mod(IYYDDD(date),100000)-iyy*1000
	 Do imm=1,12
	  If (julian.Gt.days_month(imm)) Then 
	   julian=julian-days_month(imm)
	  Else
	   idd=julian
	   goto 3333
	  Endif
	 Enddo
3333     Continue
         iyymmdd=iyy*10000+imm*100+idd	
	 
	write(chardate,'(I6)') iyymmdd
	if (chardate(1:1).eq.' ') chardate(1:1)='0'
	if (chardate(2:2).eq.' ') chardate(2:2)='0'	
	write(chartime,'(I6)') IHMS(time)
	if (chartime(1:1).eq.' ') chartime(1:1)='0'
	if (chartime(2:2).eq.' ') chartime(2:2)='0'
	if (chartime(3:3).eq.' ') chartime(3:3)='0'
	if (chartime(4:4).eq.' ') chartime(4:4)='0'			
	print*,'surferfiles/'//chardate//chartime(1:4)//'-'//name(2:leng)//
     $         '-'//'r'//charlev//'.grd'
     
	open(24,file='surferfiles/'//chardate//chartime(1:4)//'-'//
     $       name(2:leng)//'-'//'r'//charlev//'.grd')
	write (24,'(A4)') 'DSAA'
	write (24,'(2I5)') nc,100
	WRITE (24,'(2f8.2)') 0,(nc-1)*proj_args(6)
	WRITE (24,'(2f8.2)') -pf(1),-pf(100)
	WRITE (24,'(2F10.2)') ZPMIN,ZPMAX
	zpmin=0
	zpmax=0
	WRITE (24,'(10E16.6)')zp     
               
	close(24)

333     Continue	

444     Continue	
		
	close(17)
	USERFUNC = 0
      RETURN
      END
