! Program to downscale precipitation based on analog methods 
! for Iberian Peninsula and Balearic Islands (Autor: Petisco de Lara)  
! ******************************************************

SUBROUTINE down_prec(ic,id,nd,nm,nlat,nlon,nlatt,nlont,slat,slon,rlat,rlon,&
                     slatt,slont,trainpath,obspath,datapath)

USE MOD_CSTS
USE MOD_FUNCS
       
      IMPLICIT NONE

!cccccccccccccccccccccccccccccccccc
!cccccccccccccccccccccccccccccccccc
      INTEGER, INTENT(IN) :: ic
      INTEGER, INTENT(IN) :: id
      INTEGER, INTENT(IN) :: nd
      INTEGER, INTENT(IN) :: nm
      INTEGER, INTENT(IN) :: nlat
      INTEGER, INTENT(IN) :: nlon
      INTEGER, INTENT(IN) :: nlatt
      INTEGER, INTENT(IN) :: nlont
      REAL, INTENT(IN) :: slat
      REAL, INTENT(IN) :: slon
      REAL, INTENT(IN) :: rlat
      REAL, INTENT(IN) :: rlon
      REAL, INTENT(IN) :: slatt
      REAL, INTENT(IN) :: slont

      CHARACTER(LEN=*), INTENT(IN) :: trainpath
      CHARACTER(LEN=*), INTENT(IN) :: obspath
      CHARACTER(LEN=*), INTENT(IN) :: datapath
!c MDA Declaro las variables que estan sin declarar
      integer m,n
      integer i,j
      integer nvar
      integer ii
      integer jt,jp,npre
      real rlx,rly
      real sp,dd
!cccccccccccccccccccccccccccccccccc
!cccccccccccccccccccccccccccccccccc
      integer i1,i2,i3,i4,i7,iana,ice,ien,ipos,ips,ipu,ir,ire,iti,jk,k
      integer mesa,nan,nan2,nanf,nanv,nen,nmm,np
      real disu5,disu9,disv5,disv9,dmin,dt,du5,du9,dv5,dv9,supo
      real vorm,vorz

!*****************************************************************

      integer anai(nanx),ana(nanx),puh(ic)
      real u9(nd,ic),v9(nd,ic),u5(nd,ic),v5(nd,ic),he7(nd,ic),he7m(ic)
      real psl(nd,ic),ut9(p,ic),vt9(p,ic),ut5(p,ic),vt5(p,ic)
      real t5(nd,ic),t8(nd,ic),tm5(ic),tm8(ic)
      real pslm(ic),um9(ic),vm9(ic),um5(ic),vm5(ic),pslma(ic)
      real bdlon,bilat
      real pres(id),bar(id)
      real pred1(npx,nd,neni),pred1m(npx,neni)
      character sc*8,pt*9,nomeb*90

!**************lo del nuevo programa*********************

      integer nor(nanx),prs(p,nptos,npx+7)
      integer annor(nd),mesr(nd),diar(nd),diap(nm),mesp(nm),annop(nm)
      integer annoa
      integer ior(nd),anno,mes,dia,dat(31),eqc(nptos)
      integer ref(nptos),puce(neni),puen(neni,5001) ! lo dimensiono con 801 en
                                                   ! vez de con 5001 porque el maximo que alcanza es 721 
                                                   ! (con las 2 rejillas que tenemos actualmente) y por 
                                                   ! dejar un margen
      integer est(nptos)
      real prec(nd,nptos)
      real p9(ic),p5(ic)
      real dista(nd),prees(nm,nptos)
      real rlt(ic),rln(ic),rltt(id),rlnt(id)
      real dist(nanx),dist1(npx,nanx),serin(nanx)
      real aaa(nanx)
      real ser(nd),media(npx,neni),sigma(npx,neni)
      real md,sg
      real mu9(ic),su9(ic),mv9(ic),sv9(ic),copar(p,nptos,npx)
      real mu5(ic),su5(ic),mv5(ic),sv5(ic),ccm(p,nptos)
      real lati(nptos),longi(nptos),alti(nptos)

!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
!c Variables nuevas por la nueva interpolacion de los predictores

      integer Vref(nptos,4)
      real Vdis(nptos,4)
      integer iii
      real distancion1, distancion2, distancion3, distancion4
      real peso1, peso2, peso3, peso4
      real calculin_modelo, calculin_calibracion
      integer ien1, ien2, ien3, ien4
      integer ik

!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

!*******************************************************
      character path1*100,path2*100,path3*100,path4*100
      character path5*100,path6*100,path7*100,path8*100
      character path9*100,path10*100
      character nomep*80
      character for8*50,for10*50,for11*50,for15*50,for20*50,for22*50 
      character for23*50,for56*50,for88*50,for89*50 
!********************************
!  Directories
!********************************
! path1-training directory 
! path2-observations directory
! path3-ascii reanalysis directory in synoptic grid (training)
! path4-geostrophyc wind directory 
! path5-weather types (k-mean) directory
! path6-reference points directory 
! path7-significant predictors directory 
! path8-ascii reanalysis directory in synoptic grid (estimated) 
! path9-ascii reanalysis directory in low resolution grid (estimated) 
! path10-output data directory 
!********************************
      m=p
      n=nd

      path1=trim(trainpath)
      path2=trim(obspath)
      path3=trim(path1)//trim(pathSI)
      path4=trim(path1)//trim(pathgeos)
      path5=trim(path1)//trim(pathtipo)
      path6=trim(path1)//trim(pathasoc)
      path7=trim(path1)//trim(pathsig)
      path8=trim(datapath)//trim(pathSI_estim)
      path9=trim(datapath)//trim(pathLR_estim)
      path10=trim(datapath)//trim(pathout)

!********************************
!              Información importante!!
!
! getenv gets an environmental variable
!  model (modelo)  y tian (año, si 365,366, 360) son los parametros que se 
! le pasan de la LISTA_DE_PARTIDA.
! La LISTA_DE_PARTIDA  está al final del shell-script. De esta forma, va 
! trabajando modelo a modelo. 
!
!**************************
!   CALCULO DE LATITUD Y LONGITUD DE LOS PUNTOS DE LA REJILLA SINOPTICA.
!   CALCULO DE LAS PONDERACIONES USADAS EN EL CALCULO DE DISTANCIAS PARA
!  LA DETERMINACION DE ANALOGOS Y CALCULO DE LA LATITUD Y LONGITUD DE
!  CADA PUNTO DE LA REJILLA DE TRABAJO DE BAJA RESOLUCION
!
!*********************************
! 1. Calcula la lat y la lon de la rejilla sinoptica 
!  y Calculo de las ponderaciones
!
      do j=1,ic
       rlt(j)=slat+(((j-1)/nlon)*rlat)
       rln(j)=slon+((mod(j-1,nlon)+1-1)*rlon)
      enddo
             p9=0.
       p5=1.
       do i1=1,ic
        if((rlt(i1).le.fnor2).and.(rlt(i1).ge.fsur2)) then
         if((rln(i1).ge.foes2).and.(rln(i1).le.fest2)) then
          p9(i1)=1.
          p5(i1)=4.
         endif
        endif
       enddo
      do i1=1,ic
        if((rlt(i1).le.fnor1).and.(rlt(i1).ge.fsur1)) then
         if((rln(i1).ge.foes1).and.(rln(i1).le.fest1)) then
          p9(i1)=2.
          p5(i1)=8.
         endif
        endif
       enddo
!
! CALCULA LATITUD Y LONGITUD DE CADA PUNTO DE LA REJILLA DE BAJA
! TOTAL

      do j=1,id
       rltt(j)=slatt+(((j-1)/nlont)*rlat)
       rlnt(j)=slont+((mod(j-1,nlont)+1-1)*rlon)
      enddo
!
!****************************************************************
!
! LECTURA DE DATOS DE REFERENCIA (REANALISIS)
!
!  Lectura de datos de viento de base sinoptica de referencia
!  (Los vientos son los geostroficos a nivel del mar y los
!  totales en 500 hPa) para precipitacion
!  Lectura de datos de presion a nivel del mar,temperaturas y humedad
! **********************************************************
!
! Lecturas para EraInterim (training)       
!
      
      open(10,file=trim(path4)//'ug-psl-penin')
      open(11,file=trim(path4)//'vg-psl-penin')
      open(20,file=trim(path3)//'u500.dat')
      open(21,file=trim(path3)//'v500.dat')
      open(22,file=trim(path3)//'msl.dat')
      open(56,file=trim(path3)//'q700.dat')
      open(23,file=trim(path3)//'t500.dat')
      open(7,file=trim(path3)//'t850.dat')

! Formats
          
       write(for10,'(a,i03,a)') '(i4,1x,i2,1x,i2,3x,',ic,'f12.4)'
       write(for11,'(a,i03,a)') '(13x,',ic,'f12.4)'
       write(for20,'(a,i03,a)') '(19x,',ic,'f7.2)'
       write(for22,'(a,i03,a)') '(19x,',ic,'f6.0)'
       write(for56,'(a,i03,a)') '(20x,',ic,'(f4.1,1x))'
       write(for23,'(a,i03,a)') '(20x,',ic,'f6.1)'
       write(for15,'(a,i03,a)') '(15x,',ic,'f12.4)'
       write(for8,'(a,i05,a)') '(10x,',nptos,'(2x,f6.2))'
       write(for88,'(a,i03,a)') '(7x,i4,1x,i2,1x,i2,2x,',id,'f6.0)'
       write(for89,'(a,i03,a)') '(19x,',ic,'f5.1)'

       do 100 i=1,n

       read(10,for10) annor(i), mesr(i),diar(i),(u9(i,j),j=1,ic)
       read(11,for11)(v9(i,j),j=1,ic)
       read(20,for20)(u5(i,j),j=1,ic)
       read(21,for20)(v5(i,j),j=1,ic)
       read(22,for22)(psl(i,j),j=1,ic)
       read(56,for56)(he7(i,jk),jk=1,ic)
       read(23,for23)(t5(i,j),j=1,ic)
       read(7,for23)(t8(i,j),j=1,ic)
 100  continue

      close(10)
      close(11)
      close(20)
      close(21)
      close(22)
      close(23)
      close(7)
      close(56)
!
!  Lectura de datos de los tipos de la clasificacion sinoptica
!  de referencia para usar los predictores adecuados

       open(10, &
        file=trim(path5)//'u-tipos_psl_k-vgpsl_vr5-pen')
       open(11, &
        file=trim(path5)//'v-tipos_psl_k-vgpsl_vr5-pen')
       open(20, &
        file=trim(path5)//'u-tipos5k-vgpsl_vr5-pen')
       open(21, &
        file=trim(path5)//'v-tipos5k-vgpsl_vr5-pen')

      do i=1,m
       read(10,for15)(ut9(i,j),j=1,ic)
       read(11,for15)(vt9(i,j),j=1,ic)
       read(20,for15)(ut5(i,j),j=1,ic)
       read(21,for15)(vt5(i,j),j=1,ic)
      enddo
      close(10)
      close(11)
      close(20)
      close(21)
!
!
! OBSERVACIONES
!  Lectura del fichero maestro de las estaciones de Candelas
!

      open(1, &
       file=trim(path2)//'maestro_red_hr')
      do j=1,nptos
       read(1,1234) est(j),longi(j),lati(j),alti(j)
      enddo
1234   format (5x,i5,4x,f6.3,4x,f6.3,4x,f5.0)
      close(1)
!
!  Lectura de los datos de precipitacion de referencia 
!
!  en los observatorios (la precipitacion viene en decimas de mm.)
!   Para mantener una coherencia, no olvidad que como la rejilla
!   de precipitación de Candelas viene en mm, hay que multiplicarla por 10
!
      open(8, &
        file=trim(path2)//'pcp_red_1981-1996.geo')
      do ir=1,n
       read(8,for8)(prec(ir,j),j=1,nptos)
      enddo
      close(8)

!
! Conversion de mm a decimas, lo hago un poco diferente a lo que tenia
! Jorge
!
          do ir=1,n
           do j=1,nptos
              prec(ir,j)=10.*prec(ir,j)
            enddo
           enddo
!c         print *, "precipitacion en decimas de milimetro"

!     Calculamos las medias y desviaciones tipo de los datos de los
!     campos sinopticos de referencia (componentes de viento)

      do j=1,ic

       do i=1,n
        ser(i)=u9(i,j)
       enddo
       md=0.
       call estadis(ser,md,sg,n)
       mu9(j)=md
       su9(j)=sg
       do i=1,n

        ser(i)=v9(i,j)
       enddo
       call estadis(ser,md,sg,n)
       mv9(j)=md
       sv9(j)=sg

       do i=1,n
        ser(i)=u5(i,j)
       enddo
       call estadis(ser,md,sg,n)
       mu5(j)=md
       su5(j)=sg
       do i=1,n

        ser(i)=v5(i,j)
       enddo
       call estadis(ser,md,sg,n)
       mv5(j)=md
       sv5(j)=sg

      enddo

!  Lectura de los puntos de rejilla que son referencia
!  para cada estacion u observatorio


      open(1, &
!       file=trim(path6)//'puntos-referencia-estac-prec-ERAINTERIM')
      file=trim(path6)//'puntos-referencia-estac-prec-4definitivo')

      do j=1,nptos
         read(1,'(7x,4(i3,9x))',end=1099) (Vref(j,ii),ii=1,4)
      enddo
 1099 continue

      rewind(1)
      do j=1,nptos
         read(1,'(12x,4(f5.1,7x))',end=1098) (Vdis(j,ii),ii=1,4)
      enddo
 1098 continue


!      do j=1,nptos
!       read(1,'(8x,i3)') ref(j)
!      enddo
!      close(1)

!  Guardamos en una variable todos los puntos de la rejilla de baja
!  que son referencia para las estaciones, es decir establecemos
!  los centros de entornos de referencia para asi saber los puntos
!  de rejilla donde tenemos que calcular los valores de los predictores

      nen=1
      puce(1)=Vref(1,1)

!      puce(1)=ref(1)
!      do 101 j=1,nptos
!       do k=1,nen
!        if(ref(j).eq.puce(k)) go to 101
!       enddo
!       nen=nen+1
!       ipos=nen
!       puce(ipos)=ref(j)
! 101  continue

      do iii=1,4 !col
         do  j=1,nptos !rejobsv
             do  k=1,nen !castefa
                if (Vref(j,iii).eq.puce(k)) go to 101
             enddo !castefa
                nen=nen+1
                ipos=nen
                puce(ipos)=Vref(j,iii)
!                print *, nen,puce (ipos)
 101      continue
         enddo !rejobsv
      enddo !col


!      stop

!  Para cada punto de referencia encontramos las estaciones que estan
!  referidas a el, es decir, establecemos el conjunto de estaciones
!  del entorno de cada punto de referencia
           print*,'llegamos al puen'
      puen=0
!      do k=1,nen
!       do j=1,nptos
!        if(ref(j).eq.puce(k)) then
!         puen(k,801)=puen(k,801)+1
!         ipos=puen(k,801)
!         puen(k,ipos)=j
!      print*,puen(k,ipos)
!      stop
!        endif
!       enddo
!      enddo

        do k=1,nen
         do j=1,nptos
          do iii=1,4
          if(Vref(j,iii).eq.puce(k)) then
           puen(k,5001)=puen(k,5001)+1
           ipos=puen(k,5001)
           puen(k,ipos)=j
          endif
         enddo
        enddo
!        print*,puen(k,ipos)
!        stop
      enddo
   

!*****************en principio, no tendriamos que tenerlo en cuenta      
! MARTA: Quizás tú si tenías que tenerlo en cuenta. 
!  CORRESPONDENCIA DE PUNTOS DE REJILLA SINOPTICA DE IC PUNTOS CON
!  PUNTOS DE LA REJILLA REDUCIDA DE ICL PUNTOS
!
!    ila=numero de paralelos de la malla de humedad 
!    ilo=numero de meridianos de la malla de humedad
!    ipui=punto inicial de la malla de humedad referido a la total
!
!   (Se dan como parametros al principio del programa)
!
!     k=0
!     do kla=1,ila
!      ji=ipui+(kla-1)*nlon
!      do klo=1,ilo
!       j=ji-1+klo
!       k=k+1
!       puh(j)=k
!      enddo
!     enddo
!
!*****************en principio, no tendriamos que tenerlo en cuenta      
!  A CONTINUACION SE OBTIENEN Y SE ESTADARIZAN LOS DIFERENTES PREDICTORES
!  EN LA BASE DE REFERENCIA

!  OBTENCION PRESION NIVEL DEL MAR (PREDICTOR 1) EN LOS CENTROS DE ENTORNOS
!  PARA BASE DE REFERENCIA
!              print*,'predictor 1 centros'
      do i=1,n
       do j=1,nen
        ice=puce(j)
        pred1(1,i,j)=psl(i,ice)
       enddo
      enddo
      do j=1,nen
       do i=1,n
        ser(i)=pred1(1,i,j)
       enddo
       call estadis(ser,md,sg,n)
       media(1,j)=md
       sigma(1,j)=sg
       do i=1,n
        pred1(1,i,j)=(pred1(1,i,j)-media(1,j))/sigma(1,j)
       enddo
      enddo

!  OBTENCION DE LA TENDENCIA (PREDICTOR 11) EN LOS CENTROS DE ENTORNO
!  EN LA BASE DE REFERENCIA

      do j=1,nen
       pred1(11,1,j)=0.
      enddo
    
      do i=2,n
       do j=1,nen
        ice=puce(j)
        pred1(11,i,j)=psl(i,ice)-psl((i-1),ice)
       enddo
      enddo
      do j=1,nen
       do i=1,n
        ser(i)=pred1(11,i,j)
       enddo
       call estadis(ser,md,sg,n)
       media(11,j)=md
       sigma(11,j)=sg
       do i=1,n
        pred1(11,i,j)=(pred1(11,i,j)-media(11,j))/sigma(11,j)
       enddo
      enddo


!  OBTENCION GRADIENTE TERMICO VERTICAL(PREDICTOR 3)
!  EN LOS CENTROS DE ENTORNOS PARA BASE DE REFERENCIA

      do i=1,n
       do j=1,nen
        ice=puce(j)
        pred1(3,i,j)=t8(i,ice)-t5(i,ice)
       enddo
      enddo
      do j=1,nen
       do i=1,n
        ser(i)=pred1(3,i,j)
       enddo
       call estadis(ser,md,sg,n)
       media(3,j)=md
       sigma(3,j)=sg
       do i=1,n
        pred1(3,i,j)=(pred1(3,i,j)-media(3,j))/sigma(3,j)
       enddo
      enddo



!  OBTENCION DE TEMPERATURA EN 500 (PREDICTOR 2)
!  EN LOS CENTROS DE ENTORNOS PARA BASE DE REFERENCIA

      do i=1,n
       do j=1,nen
        ice=puce(j)
        pred1(2,i,j)=t5(i,ice)
       enddo
      enddo

      do j=1,nen
       do i=1,n
        ser(i)=pred1(2,i,j)
       enddo
       call estadis(ser,md,sg,n)
       media(2,j)=md
       sigma(2,j)=sg
       do i=1,n
        pred1(2,i,j)=(pred1(2,i,j)-media(2,j))/sigma(2,j)
       enddo
      enddo

!  OBTENCION VORTICIDAD (PREDICTOR 4) EN LOS CENTROS DE ENTORNOS
!  PARA BASE DE REFERENCIA

      do i=1,n
       do j=1,nen
        ice=puce(j)
        rlx=rt*cos(rlt(ice)*pi/180.)*pi*rlon/180.
        rly=rt*abs(rlat)*pi/180.
        vorm=u9(i,ice-nlon)-u9(i,ice+nlon)
        vorm=vorm/(2.*rly)
        vorz=v9(i,ice+1)-v9(i,ice-1)
        vorz=vorz/(2.*rlx)
        pred1(4,i,j)=vorz-vorm
       enddo
      enddo
      do j=1,nen
       do i=1,n
        ser(i)=pred1(4,i,j)
       enddo
       call estadis(ser,md,sg,n)
       media(4,j)=md
       sigma(4,j)=sg
       do i=1,n
        pred1(4,i,j)=(pred1(4,i,j)-media(4,j))/sigma(4,j)
       enddo
      enddo

!  OBTENCION COMPONENTES DE GESTROFICO (PREDICTORES 5 Y 6) EN CENTRO DE ENTORNOS
!  PARA BASE DE REFERENCIA

      do i=1,n
       do j=1,nen
        ice=puce(j)
        pred1(5,i,j)=u9(i,ice)
        pred1(6,i,j)=v9(i,ice)
       enddo
      enddo
      do j=1,nen
       do i=1,n
        ser(i)=pred1(5,i,j)
       enddo
       call estadis(ser,md,sg,n)
       media(5,j)=md
       sigma(5,j)=sg
       do i=1,n
        pred1(5,i,j)=(pred1(5,i,j)-media(5,j))/sigma(5,j)
       enddo
      enddo
      do j=1,nen
       do i=1,n
        ser(i)=pred1(6,i,j)
       enddo
       call estadis(ser,md,sg,n)
       media(6,j)=md
       sigma(6,j)=sg
       do i=1,n
        pred1(6,i,j)=(pred1(6,i,j)-media(6,j))/sigma(6,j)
       enddo
      enddo

!  OBTENCION VORTICIDAD EN 500 (PREDICTOR 7) EN LOS CENTROS DE ENTORNOS

      do i=1,n
       do j=1,nen
        ice=puce(j)
        rlx=rt*cos(rlt(ice)*pi/180.)*pi*rlon/180.
        rly=rt*abs(rlat)*pi/180.
        vorm=u5(i,ice-nlon)-u5(i,ice+nlon)
        vorm=vorm/(2.*rly)
        vorz=v5(i,ice+1)-v5(i,ice-1)
        vorz=vorz/(2.*rlx)
        pred1(7,i,j)=vorz-vorm
       enddo
      enddo
      do j=1,nen
       do i=1,n
        ser(i)=pred1(7,i,j)
       enddo
       call estadis(ser,md,sg,n)
       media(7,j)=md
       sigma(7,j)=sg
       do i=1,n
        pred1(7,i,j)=(pred1(7,i,j)-media(7,j))/sigma(7,j)
       enddo
      enddo


!  OBTENCION COMPONENTES DE GESTROFICO EN 500 (PREDICTORES 8 Y 9) EN CENTRO DE ENTORNOS

      do i=1,n
       do j=1,nen
        ice=puce(j)
        pred1(8,i,j)=u5(i,ice)
        pred1(9,i,j)=v5(i,ice)
       enddo
      enddo
      do j=1,nen
       do i=1,n
        ser(i)=pred1(8,i,j)
       enddo
       call estadis(ser,md,sg,n)
       media(8,j)=md
       sigma(8,j)=sg
       do i=1,n
        pred1(8,i,j)=(pred1(8,i,j)-media(8,j))/sigma(8,j)
       enddo
      enddo
      do j=1,nen
       do i=1,n
        ser(i)=pred1(9,i,j)
       enddo
       call estadis(ser,md,sg,n)
       media(9,j)=md
       sigma(9,j)=sg
       do i=1,n
        pred1(9,i,j)=(pred1(9,i,j)-media(9,j))/sigma(9,j)
       enddo
      enddo



!  OBTENCION Hum Especi en 700 EN LOS CENTROS DE ENTORNOS
!  PARA BASE DE REFERENCIA

      do i=1,n
       do j=1,nen
        ice=puce(j)
        pred1(10,i,j)=he7(i,ice)
       enddo
      enddo
      do j=1,nen
       do i=1,n
        ser(i)=pred1(10,i,j)
       enddo
       call estadis(ser,md,sg,n)
       media(10,j)=md
       sigma(10,j)=sg
       do i=1,n
        pred1(10,i,j)=(pred1(10,i,j)-media(10,j))/sigma(10,j)
       enddo
      enddo
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!



!     TIPIFICAMOS LOS DATOS DE VIENTOS DE REFERENCIA
!     (TAMBIEN EN LOS TIPOS SINOPTICOS)

      do i=1,n
       do j=1,ic
        u9(i,j)=(u9(i,j)-mu9(j))/su9(j)
        v9(i,j)=(v9(i,j)-mv9(j))/sv9(j)
        u5(i,j)=(u5(i,j)-mu5(j))/su5(j)
        v5(i,j)=(v5(i,j)-mv5(j))/sv5(j)
       enddo
      enddo

      do i=1,m
       do j=1,ic
        ut9(i,j)=(ut9(i,j)-mu9(j))/su9(j)
        vt9(i,j)=(vt9(i,j)-mv9(j))/sv9(j)
        ut5(i,j)=(ut5(i,j)-mu5(j))/su5(j)
        vt5(i,j)=(vt5(i,j)-mv5(j))/sv5(j)
       enddo
      enddo

!  LECTURA DE PREDICTORES SIGNIFICATIVOS PARA CADA TIPO SINOPTICO EN CADA PUNTO
      
      open(7, &
      file=trim(path7)//'predic-obs-tipos-cdet-vgeo_psl-vr5-11p-pen')
 997  continue
      read(7,22,end=998) &
       jt,jp,npre,ccm(jt,jp),(prs(jt,jp,k),copar(jt,jp,k),k=1,npre)
       prs(jt,jp,npx+7)=npre
      go to 997
 998  continue
 22   format(3x,i5,3x,i5,4x,i2,5x,f5.2,2x,11(2x,i2,1x,f5.2))

      close(7)
!
!
! ESTIMA DE PRECIPITACIONES DE LOS DIAS PROBLEMA DEL MODELO
! EN LOS PUNTOS DE REJILLA CANDELAS (REGIONALIZACION)
!
       print*,'Empiezo a regionalizar'

! Apertura de los ficheros de datos del modelo a regionalizar 
!
! nomeb se refiere a la rejilla sinoptica
! nomep se refiere a la rejilla en baja resolucion
!
           nomeb=trim(path8)
           nomep=trim(path9)

      open(20, file=trim(nomeb)//'u500.dat')
      open(21, file=trim(nomeb)//'v500.dat')
      open(22, file=trim(nomep)//'msl.dat')
      open(56, file=trim(nomeb)//'q700.dat')
      open(23, file=trim(nomeb)//'t500.dat')
      open(7, file=trim(nomeb)//'t850.dat')
!

! Continuamos 
      nmm=0
!MDA
      do 1000 i=1,nm

!      Leemos los datos de campo sinoptico del dia problema
!      Leemos los datos de presion a nivel del mar del dia problema
!         (en rejilla de id puntos)
!      Leemos los datos de temperatura en 850 y 500 del dia problema
!      Leemos los datos de humedad especifica en 700 del dia problema

       read(20,for20,end=1001) (um5(j),j=1,ic)
       read(21,for20,end=1001) (vm5(j),j=1,ic)
       read(22,for88,end=1001) anno,mes,dia,(pres(k),k=1,id)
!
       read(56,for89,end=1001)(he7m(jk),jk=1,ic)
       read(23,for23,end=1001)(tm5(j),j=1,ic)
       read(7,for23,end=1001)(tm8(j),j=1,ic)
       print*,'dia de estimacion ',i
       nmm=nmm+1

!      Obtenemos la rejilla de presion de ic puntos
!      a partir de la rejilla inicialmente leida de id puntos

      bilat=slat+(nlat-1)*rlat
      bdlon=slon+(nlon-1)*rlon

       ire=0
       do 111 j=1,id
        if((rltt(j).gt.slat).or.(rltt(j).lt.bilat)) go to 111
        if((rlnt(j).lt.slon).or.(rlnt(j).gt.bdlon)) go to 111
        ire=ire+1
        pslm(ire)=pres(j)
  111  continue

!      Calculamos las componentes del geostrofico a nivel del mar
!      para el dia problema
!      (La presion se pone en pascales y dividimos por g para anular
!       la aceleracion de la gravedad en la subrutina ya que esta dise-
!       nnada para calcular geostrofico a partir de geopotencial y no
!       de presion)

       bar=pres*100./g

!    !!!!! MUY IMPORTANTE !!!!!!
!      CAMBIAR LOS PARAMETROS DE LAS COORDENADAS GEOGRAFICAS,
!      SEGUN SEA LA ZONA, EN LA SUBRUTINA QUE CALCULA EL
!      GEOSTROFICO. 

       call geostrofico(bar,um9,vm9,id,ic,slatt,slont,slat,slon,&
                   rlat,rlon,rlat,rlon,nlatt,nlont,nlat,nlon)

!      Finalmente dividimos por la densidad para obtener las
!      componentes del viento geostrofico
!      Utilizamos la densidad a nivel del mar de la atmosfera standard

       do j=1,ic
        um9(j)=um9(j)/1.225
        vm9(j)=vm9(j)/1.225
       enddo

!      Calculamos los valores de los predictores para el dia problema

!  OBTENCION T500 (PREDICTOR 2) EN LOS CENTROS DE ENTORNOS
!  PARA DIA PROBLEMA Y TIPIFICACION

       do j=1,nen
        ice=puce(j)
        pred1m(2,j)=tm5(ice)
        pred1m(2,j)=(pred1m(2,j)-media(2,j))/sigma(2,j)
       enddo

!  OBTENCION PRESION NIVEL MAR (PREDICTOR 1) EN LOS CENTROS DE ENTORNOS
!  PARA DIA PROBLEMA Y TIPIFICACION

       do j=1,nen
        ice=puce(j)
        pred1m(1,j)=pslm(ice)
        pred1m(1,j)=(pred1m(1,j)-media(1,j))/sigma(1,j)
       enddo

!  OBTENCION DE TENDENCIA DE PRESION (PREDICTOR11) EN CENTROS DE ENTORNOS
!  PARA DIA PROBLEMA Y TIPIFICACION

       if(i.eq.1) then
       do j=1,nen
        pred1m(11,j)=0.
       enddo
       else
       do j=1,nen
        ice=puce(j)
        pred1m(11,j)=pslm(ice)-pslma(ice)
        pred1m(11,j)=(pred1m(11,j)-media(11,j))/sigma(11,j)
       enddo
       endif

       pslma=pslm


!  OBTENCION GRADIENTE TERMICO (PREDICTOR 3) EN LOS CENTROS DE ENTORNOS
!  PARA DIA PROBLEMA Y TIPIFICACION

       do j=1,nen
        ice=puce(j)
        pred1m(3,j)=tm8(ice)-tm5(ice)
        pred1m(3,j)=(pred1m(3,j)-media(3,j))/sigma(3,j)
       enddo


!  OBTENCION VORTICIDAD (PREDICTOR 4) EN LOS CENTROS DE ENTORNOS
!  PARA DIA PROBLEMA Y TIPIFICACION

       do j=1,nen
        ice=puce(j)
        rlx=rt*cos(rlt(ice)*pi/180.)*pi*rlon/180.
        rly=rt*abs(rlat)*pi/180.
        vorm=um9(ice-nlon)-um9(ice+nlon)
        vorm=vorm/(2.*rly)
        vorz=vm9(ice+1)-vm9(ice-1)
        vorz=vorz/(2.*rlx)
        pred1m(4,j)=vorz-vorm
        pred1m(4,j)=(pred1m(4,j)-media(4,j))/sigma(4,j)
       enddo

!  OBTENCION COMPONENTES DE GESTROFICO (PREDICTORES 5 Y 6) EN CENTRO DE ENTORNOS
!  PARA DIA PROBLEMA Y TIPIFICACION

       do j=1,nen
        ice=puce(j)
        pred1m(5,j)=um9(ice)
        pred1m(5,j)=(pred1m(5,j)-media(5,j))/sigma(5,j)
        pred1m(6,j)=vm9(ice)
        pred1m(6,j)=(pred1m(6,j)-media(6,j))/sigma(6,j)
       enddo

!  OBTENCION VORTICIDAD 500 (PREDICTOR 7) EN LOS CENTROS DE ENTORNOS
!  PARA DIA PROBLEMA Y TIPIFICACION

       do j=1,nen
        ice=puce(j)
        rlx=rt*cos(rlt(ice)*pi/180.)*pi*rlon/180.
        rly=rt*abs(rlat)*pi/180.
        vorm=um5(ice-nlon)-um5(ice+nlon)
        vorm=vorm/(2.*rly)
        vorz=vm5(ice+1)-vm5(ice-1)
        vorz=vorz/(2.*rlx)
        pred1m(7,j)=vorz-vorm
        pred1m(7,j)=(pred1m(7,j)-media(7,j))/sigma(7,j)
       enddo

!  OBTENCION COMPONENTES DE GESTROFICO (PREDICTORES 8 Y 9) EN CENTRO DE ENTORNOS
!  PARA DIA PROBLEMA Y TIPIFICACION

       do j=1,nen
        ice=puce(j)
        pred1m(8,j)=um5(ice)
        pred1m(8,j)=(pred1m(8,j)-media(8,j))/sigma(8,j)
        pred1m(9,j)=vm5(ice)
        pred1m(9,j)=(pred1m(9,j)-media(9,j))/sigma(9,j)
       enddo


!  OBTENCION DE HUMEDAD ESPECIFICA EN 700 
!  EN LOS CENTROS DE ENTORNO PARA DIA PROBLEMA Y TIPIFICACION

       do j=1,nen
        ice=puce(j)
        !pred1m(10,j)=he7m(puh(ice))
        pred1m(10,j)=he7m(ice)
        pred1m(10,j)=(pred1m(10,j)-media(10,j))/sigma(10,j)
       enddo



!  ESTANDARIZAMOS LOS DATOS DE VIENTO DEL DIA PROBLEMA

       do j=1,ic
        um9(j)=(um9(j)-mu9(j))/su9(j)
        vm9(j)=(vm9(j)-mv9(j))/sv9(j)
        um5(j)=(um5(j)-mu5(j))/su5(j)
        vm5(j)=(vm5(j)-mv5(j))/sv5(j)
       enddo

!      Determinamos el tipo sinoptico al que pertenece el dia problema
!      Esto nos permitira saber que predictores adicionales a la configuracion
!      sinoptica debemos utilizar en cada punto (observatorio) donde
!      se va a hacer la regionalizacion de precipitacion

       dmin=99999.
       iti=0
       do j=1,m
        call distan9_2(um9,ut9,m,j,p9,du9,ic)
        call distan9_2(vm9,vt9,m,j,p9,dv9,ic)
        call distan5_2(um5,ut5,m,j,p5,du5,ic)
        call distan5_2(vm5,vt5,m,j,p5,dv5,ic)
        dd=(du9+dv9+du5+dv5)/4.
        if(dd.lt.dmin) then
         dmin=dd
         iti=j
!         print*,j,dmin,iti
        endif
       enddo


!      Determinamos los nanx elementos de referencia mas analogos
!      sinopticamente al dia problema y sus distancias correspondientes

       do i1=1,n
        ior(i1)=i1
        dista(i1)=9999.
       enddo
       do 113 i1=1,n
        call distan9_2(um9,u9,n,i1,p9,disu9,ic)
        call distan9_2(vm9,v9,n,i1,p9,disv9,ic)
        call distan5_2(um5,u5,n,i1,p5,disu5,ic)
        call distan5_2(vm5,v5,n,i1,p5,disv5,ic)
        dista(i1)=(disu9+disv9+disu5+disv5)/4.
 113   continue
       call burbuja1(dista,ior,n,nanx)
       do i1=1,nanx
        anai(i1)=ior(i1)
       enddo
      
!      Tomamos ahora todos los puntos de referencia de la rejilla
!      sinoptica de baja resolucion y para cada
!      uno de ellos consideramos los puntos (observatorios) asociados con el
!      y que son los puntos donde vamos a regionalizar
!      (ien  son los entornos o puntos de referencia)
!      (ipu  son los puntos u observatorios asociados con el  ien correspondiente)
!      NOTA: Los observatorios cuyo numero de orden en la lista es 1681,1967 y 305)
!      se excluyen por no tener datos de precipitacion. No se eliminaron en su momento
!      para evitar posibles errores al ser necesario cambiar los numeros de orden
!      iniciales de la lista de los observatorios.

!******************comentario del 10.9.2018-susceptible de borrar 
!
! IMPORTANTE mirad la dimension de los puen
!C creo que esto no viene a colacion aqui porque se refiere a los
!C tres observatorios que daban problemas 
!
!descomentado x el programa de Jorge
      do 1100 ien=1,nen 
       do 1200 i2=1,puen(ien,5001)
        ipu=puen(ien,i2)
!****************
!        Consideramos solo los analogos que tienen dato en el punto
!        cuestion y determinamos el numero de ellos
!        cuya distancia al dia problema es menor que el umbral umb

         nan=0
         nanf=0
         do i3=1,nanx
         iana=anai(i3)
          if(prec(iana,ipu).ne.-999.) then
           nan=nan+1
           ana(nan)=iana
           dist(nan)=dista(i3)
           if(dist(nan).eq.0.0) dist(nan)=0.1
           if(dist(nan).le.umb) nanf=nanf+1
          endif
         enddo
         if(nan.lt.nmin) then
          print*,i,ipu,' no hay suficientes analogos '
          goto 1200
         endif
         if(nanf.le.nmin) nanf=nmin

!       Todos estos nanf analogos tienen distancia con el dia problema 
!       menor que el umbral umb establecido y decimos que tienen
!       similitud sinoptica con el dia problema


!        Tomamos los predictores significativos para la estima de
!        precipitacion para el tipo sinoptico del dia problema y en el
!        punto de observacion considerado

         np=prs(iti,ipu,npx+7)
         if(ccm(iti,ipu).lt.ccmi) np=0

!        Si el numero de predictores significativos es nulo la estima se
!        realiza unicamente con la analogia sinoptica

         if(np.eq.0) then
           if(nanf.gt.nmax) then
            nan2=nmax
           else
            nan2=nanf
           endif

!          Estima de precipitacion

           prees(i,ipu)=0.
           sp=0.
           do i3=1,nan2
            iana=ana(i3)
            dt=dist(i3)
            sp=sp+1./dt
            prees(i,ipu)=prees(i,ipu)+prec(iana,ipu)*(1./dt)
           enddo
           prees(i,ipu)=prees(i,ipu)/sp
           go to 1200
         endif

!        Si hay predictores significativos 
!        para cada predictor significativo mencionado se determinan las
!        distancias en el punto de referencia que corresponda, entre el dia
!        problema y los distintos analogos (las distancias son cuadraticas)

         do ik=1,nen
           ice=puce(ik)

           if (Vref(ipu,1).eq.ice) then
             ien1=ik   !fila de puce en el que está ipu referenciado
             distancion1=Vdis(ipu,1)
             peso1=1/distancion1
             go to 251
           endif
         enddo
 251     continue


         do ik=1,nen
           ice=puce(ik)
           !if(ref(ipu).eq.ice) then   !### aqui sera el cambio, habra
           !ien1,ien2,ien3,ien4
           ! ien=ik
           ! go to 252
           if (Vref(ipu,2).eq.ice) then
             ien2=ik
             distancion2=Vdis(ipu,2)
             peso2=1/distancion2
             go to 252
           endif
         enddo
 252     continue

          do ik=1,nen
           ice=puce(ik)
           !if(ref(ipu).eq.ice) then   !### aqui sera el cambio, habra
           !ien1,ien2,ien3,ien4
           ! ien=ik
           ! go to 252
           if (Vref(ipu,3).eq.ice) then
             ien3=ik
             distancion3=Vdis(ipu,3)
             peso3=1/distancion3
             go to 253
           endif
         enddo
 253     continue


          do ik=1,nen
           ice=puce(ik)
           !if(ref(ipu).eq.ice) then   !### aqui sera el cambio, habra
           !ien1,ien2,ien3,ien4
           ! ien=ik
           ! go to 252
           if (Vref(ipu,4).eq.ice) then
             ien4=ik
             distancion4=Vdis(ipu,4)
             peso4=1/distancion4
             go to 254
           endif
         enddo
 254     continue


!c calculos de Jorge mientras programaba los cambios para la interpolacion de
!los predictores.

     !do cuenta_pred_sig=1,npre
         !numero_del_predictor_que_me_interesa()=prs(iti,ipu,cuenta_pred_sig)
         !! saber que  prs(jt,jp,npx+7)=npre  !npx=11  !pred1m(npx,neni)
                  !para cada  predictor_que_me_interesa: 
                  !pred1m(numero_del_predictor_que_me_interesa,)=calculo_interpolado= 
                 !calculin=pred1m(jp,ien1)*peso1+pred1m(jp,ien2)*peso2 +
                 !pred1m(jp,ien3)*peso3+pred1m(jp,ien4)*peso4    /
                 !(peso1+peso2+peso3+peso4)
         !pred(kp)= calculin/(peso1+peso2+peso3+peso4)
                

         do 1250 i4=1,np
          ips=prs(iti,ipu,i4)
          do i1=1,nanf
           iana=ana(i1)
!c           dist1(ips,i1)=(pred1m(ips,ien)-pred1(ips,iana,ien))**2
           calculin_modelo = pred1m(ips,ien1)*peso1+pred1m(ips,ien2)* &
      peso2+pred1m(ips,ien3)*peso3+pred1m(ips,ien4)*peso4/(peso1+peso2+ &
      peso3+peso4)
           calculin_calibracion = pred1(ips,iana,ien1)*peso1+ &
      pred1(ips,iana,ien2)*peso2+pred1(ips,iana,ien3)*peso3+ &
      pred1(ips,iana,ien4)*peso4/(peso1+peso2+peso3+peso4)

      dist1(ips,i1)=(calculin_modelo - calculin_calibracion)**2

          enddo
 1250    continue

!        Se ordenan los nanf analogos de mayor a menor similaridad
!        media (de similaridad sinoptica y del conjunto de predictores)
!        con el dia problema

          do ii=1,nanf
           aaa(ii)=0.
           nor(ii)=ii
          enddo
          nanv=0
          do ii=1,nanf
           supo=0.
           do i7=1,np
            ips=prs(iti,ipu,i7)
            aaa(ii)= aaa(ii)+dist1(ips,nor(ii))*copar(iti,ipu,i7)
            supo=supo+copar(iti,ipu,i7)
           enddo
           aaa(ii)=aaa(ii)/supo
           if(aaa(ii).eq.0.) aaa(ii)=0.1
           if(aaa(ii).le.umbl) nanv=nanv+1
           serin(ii)=(aaa(ii)+dist(nor(ii)))/2.
          enddo
          call burbuja(serin,nor,nanf,nanf,nanf)

!        Calculamos la precipitacion estimada en el punto considerado
!        y en el dia problema, como la media ponderada de la precipitacion
!        en el punto considerado para todos los analogos seleccionados
!        siendo las ponderaciones las correspondientes distancias medias
!        de todos los predictores (configuracion sinoptica y predictores en
!        el punto de referencia)


!        Si el numero de analogos con similaridad de predictores (distancia menor o igual que umbl) 
!        en el punto de referencia (predictores locales) es mayor o igual que el minimo numero
!        la estima se hace tomando los analogos que tienen similitud de predictores locales,
!         (ademas de la sinoptica ya considerada)

!      print*,'antes del if:','nanf = ',nanf,'nanv = ',nanv,'nmin = ',
!     &nmin
!      stop

         if(nanv.lt.nmin) go to 1998
         prees(i,ipu)=0.
         sp=0.
         nan2=0
         do 8888 ii=1,nanf
          if(aaa(nor(ii)).gt.umbl) go to 8888
          iana=ana(nor(ii))
          dt=serin(ii)
          sp=sp+(1./dt)
          prees(i,ipu)=prees(i,ipu)+prec(iana,ipu)*(1./dt)
          nan2=nan2+1
          if(nan2.eq.nmax) go to 1995
 8888    continue
 1995    continue
         prees(i,ipu)=prees(i,ipu)/sp

         go to 1200

!        Si el numero de analogos con similaridad de predictores locales
!        es menor que el minimo numero de analogos requerido,
!        la estima se hace tomando los analogos con similitud local que haya
!        entre los seleccionados con similitud sinoptica
!        y completando con el resto de analogos por orden de similitud total hasta
!        completar el minimo numero de analogos requerido

 1998    continue
         prees(i,ipu)=0.
         sp=0.
         nan2=0
!      1) SI HAY ALGUN ANALOGO CON SIMILITUD LOCAL LO TOMAMOS
         if(nanv.gt.0) then
          do 8889 ii=1,nanf
           if(aaa(nor(ii)).gt.umbl) go to 8889
           nan2=nan2+1
           iana=ana(nor(ii))
           dt=serin(ii)
           sp=sp+(1./dt)
           prees(i,ipu)=prees(i,ipu)+prec(iana,ipu)*(1./dt)
 8889     continue
!         Y COMPLETAMOS CON RESTO DE ANALOGOS POR ORDEN DE SIMILITUD TOTAL
!         HASTA EL NUMERO MINIMO DE ANALOGOS
          do 8890 ii=1,nanf
           if(aaa(nor(ii)).le.umbl) go to 8890
           nan2=nan2+1
           iana=ana(nor(ii))
           dt=serin(ii)
           sp=sp+(1./dt)
           prees(i,ipu)=prees(i,ipu)+prec(iana,ipu)*(1./dt)
           if(nan2.eq.nmin) go to 1997
 8890     continue
 1997     continue
          prees(i,ipu)=prees(i,ipu)/sp
          go to 1200
!        2) SI NO HAY ANALOGOS CON SIMILITUD LOCAL TOMAMOS ANALOGOS
!         POR ORDEN DE SIMILITUD TOTAL (sinoptica+predictores locales)
!         HASTA ALCANZAR EL NUMERO MINIMO DE ANALOGOS
         elseif(nanv.eq.0) then
          do ii=1,nmin
           nan2=nan2+1
           iana=ana(nor(ii))
           dt=serin(ii)
           sp=sp+(1./dt)
           prees(i,ipu)=prees(i,ipu)+prec(iana,ipu)*(1./dt)
          enddo
          prees(i,ipu)=prees(i,ipu)/sp
          go to 1200
         endif


 1200   continue
 1100   continue
       
       diap(i)=dia
       mesp(i)=mes
       annop(i)=anno

 1000 continue
 1001 continue
      close(20)
      close(21)
      close(22)
      close(56)
      close(23)
      close(7)


! MDAW 
      open(4, &
!      file=trim(path10)//'precip.'//trim(mdl)//'.1997-2017')
      file=trim(path10)//'precip.1997_newint')
!      file=trim(path10)//'precip.'//trim(mdl)//'.1-5enero1997')

!      write(4,25) mdl
      write(4,*) " CELDA  LAT  LON    ALT"

      do j=1,nptos
!      do j=1,2
       write(4,26) est(j),lati(j),longi(j),alti(j)
       mesa=mesp(1)
       annoa=annop(1)
       dat=-999
       do i=1,nmm
        if((mesp(i).eq.mesa).and.(annop(i).eq.annoa)) then
         dat(diap(i))=nint(prees(i,j))
         if(i.eq.nmm) then
          write(4,27) est(j),annop(i),mesp(i),(dat(k),k=1,31)
         endif
         mesa=mesp(i)
         annoa=annop(i)
        else
         write(4,27) est(j),annop(i-1),mesp(i-1),(dat(k),k=1,31)
         dat=-999
         dat(diap(i))=nint(prees(i,j))
         if(i.eq.nmm) then
          write(4,27) est(j),annop(i),mesp(i),(dat(k),k=1,31)
         endif
         mesa=mesp(i)
         annoa=annop(i)
        endif
       enddo
      enddo
      close(4)

! Formatos de escritura
! 25   format('prec ',a6,'1997-2017 (5Km) decimas-mm') 
 25   format('prec ',a6,'1997 (5Km) decimas-mm') 
 26   format(i5,1x,f6.3,1x,f6.3,1x,f5.0)
 27   format(i5,1x,i4,1x,i2,2x,31(1x,i5))

END SUBROUTINE down_prec

