!     Last change:  ASS   6 May 2009    3:45 pm
! PROGRAMA PARA EXTRAER SERIES DE RESULTADOS DE SIMGES EN TABLA.TXT
! Y ESCRIBIRLOS EN OTROS ARCHIVOS MODIFICANDOLOS CON COEFICIENTES.
! ------------------------------------------------------------------------------
! Fuentes en fortran 90. Los EXE se han compilado con Lahey95 para windows.
!
! Desarrollado por Abel Solera. (asolera@upvnet.upv.es)
! Si alguien mejora o amplia o modifica el programa, le pido por favor me lo
! cuente en un correo electrónico para publicarlo en el portal de desarrollo
! de aquatool (http://www.iiama.upv.es/aquatool).
! ------------------------------------------------------------------------------

!program ges2gis
!! Mensaje de inicio del proceso.
!        CALL ERRORR(1000)
!! Si existe CONFIG1.AQT lee de este los nombres de archivos y otros cámbios
!! al proceso normal.
!        CALL LEECONFIG()
!! Lectura datos del contenido del archivo de la simulación.
!        call leedatsim()
!! Lectura de datos para la extracción de resultados.
!        call leedatdesagre()
!        call calcula()
!! Escritura fin del proceso
!        call errorr(1009)
!        call fin()
!end program
!-------------------------------------------------------------------------------------------
module mfiles !variables manejo archivos
  IMPLICIT NONE
  CHARACTER(LEN=250)::datos1='config1.aqt',tablatxt='tabla.txt',tabladir2='tabla.dir2'
  CHARACTER(LEN=250)::gistosimges='gistosimges.txt',tabla2='tabla2.txt',resultbd='G2SaBD.csv'
  INTEGER::d1=20,it1=21,idir2=22,ig2s=23,it2=24,ibd=25,annio1=0,iSALBD=1
  INTEGER::IDETALLE=0,ICODFIN=0
  CHARACTER(LEN=1)::chsep=CHAR(9),chDel=CHAR(39) ! 9=tab, 44=coma, 32=espacio,59=PTOCOMA, 34=comillas dobles, 39=comilla simple
end module
!
MODULE mDIR ! variables para lectura de directorio datos simges
  INTEGER,DIMENSION(:),allocatable::dirCodTipo,dirCodElem,dirCodDato,dirNumRes
  INTEGER::nd
END MODULE
!
module mg2s  !variables para cálculo
  INTEGER,DIMENSION(:),allocatable::g2sIdatoTabla,g2sTipoDatoG
  CHARACTER(LEN=50),DIMENSION(:),allocatable::g2sCodGis,G2SCODIGOS,g2sDescrGIS
  REAL,DIMENSION(:),allocatable::G2sCoef
  INTEGER::ng2s,fmtDatos=7

end module
!-------------------------------------------------------------------------------------------
subroutine Calcula()   !-------------------- proceso de lectura y cálculo series
     USE mfiles
     use mg2s
     use mdir,ONLY:nd

     REAL,DIMENSION(:),allocatable::lect,calc
     INTEGER::nline,i,er,i1,i2,i3,imes,ianio=0
     CHARACTER(LEN=1)::pc=CHAR(59)
     CHARACTER(LEN=40)::tit1

     OPEN (it1,FILE=tablatxt,STATUS='OLD',ERR=101)
     OPEN (it2,FILE=tabla2,ERR=102)
     if (isalbd.eq.1) OPEN (ibd,FILE=resultbd,ERR=102)

     ALLOCATE(lect(nd),calc(ng2s), STAT=er)
     IF (ER.NE.0) call errorr(100,0)

     !Escritura encabezamiento
     WRITE(it2,*)'<NUMEROSERIES>'
     WRITE(it2,*)NG2S
     WRITE(it2,*)'<NUMERODATOS>'
     nline=0
     do !  bucle para leer el archivo tabla.txt y contar el número de líneas
        read (it1,*,ERR=30,END=30)
        nline=nline+1
     END do
 30  continue
     REWIND(it1)
     WRITE(it2,*)nline
	 !Si se selecciona escribe además una segunda línea con el descriptor entre comillas.
	 if(fmtDatos.gt.20) then
		WRITE(it2,*)'<DESCRIPTORES>'
		WRITE(it2,*)((chdel,TRIM(g2sDescrGIS(i)),chdel,chsep),i=1,ng2s)
	 endif
     WRITE(it2,*)'<RESULTADOS>'
     WRITE(it2,*)((chdel,TRIM(g2scodgis(i)),chdel,chsep),i=1,ng2s)
!
     if (isalbd.eq.1) then
       tit1=chdel//'IdGis'//chdel//pc//chdel//'Annio'//chdel//pc//chdel//'Mes'//chdel
       tit1=TRIM(tit1)//pc//chdel//'Valor'//chdel//pc//chdel//'TipoDato'//chdel
     WRITE(ibd,*)tit1
     endif

     NLINE=0
     CALL ERRORR(1010)
     do !bucle por líneas de archivo tabla.txt
        ! lectura de datos
!        READ (it1,*,ERR=103) i1,i2,i3,(lect(i),i=1,nd)
!        READ (it1,*,END=20,ERR=103) i1,i2,i3,(lect(i),i=1,nd)
! nov-2012 en tabla.txt se ha quitados los primeros 3 enteros
        READ (it1,*,END=20,ERR=103) (lect(i),i=1,nd)

        NLINE=NLINE+1
        IF (IDETALLE.EQ.1) WRITE(*,'(I4)',ADVANCE='NO')NLINE

        do i=1,ng2s !bucle por datos a calcular.
           !obtiene dato,!calcula
           calc(i)=lect(g2sidatotabla(i))*g2scoef(i)
        END do
        !escribe resultados en formato Tabla
!        WRITE(it2,'(f12.3,a1)')((calc(i),chsep),i=1,ng2s)
        WRITE (it2,*)((calc(i),chsep),i=1,ng2s)
!        PRINT it2,*,((calc(i),chsep),i=1,ng2s)
        !escribe resultados en formato para base de datos
        if (isalbd.eq.1) then
          if (aNnio1.ne.0) then
            ianio=annio1+(nline+8)/12
            imes=MOD(nline+9,12)
            if (imes.eq.0) imes=12
          else
            imes=nline
          end if
          do i=1,ng2s
           WRITE(iBD,*)g2scodgis(i),pc,ianio,pc,imes,pc,calc(i),pc,g2sTipoDatoG(i)
          end do
        end if
     end do

20   continue
     IF (IDETALLE.EQ.1) WRITE(*,'(/A18,I4)')'FINALIZA EN LÍNEA ',NLINE

     CLOSE(it1,ERR=21)
     CLOSE(it2,ERR=21)
     if (isalbd.eq.1) CLOSE(ibd,ERR=21)
21   continue
return

101     CONTINUE
        CALL ERRORr(104,0)
102     CONTINUE
        CALL ERRORr(106,0)
103     CONTINUE
        CALL ERRORr(105,nline)
        RETURN
end subroutine

!--------------------------------------------procesos lectura--------------------------------
SUBROUTINE LEEDATSIM()   !lectura de datos directorio simges tabla.dir2
     USE mfiles
     use mdir
!
     INTEGER::nline,i,er
     OPEN (idir2,FILE=tabladir2,STATUS='OLD',ERR=101)
     NLINE=1
     do
        READ (idir2,*,END=20)
        NLINE=NLINE+1
     end do
20   CONTINUE

     Nd=NLINE-1

    call errorr(1008,nd)
     IF (Nd.lt.1) GOTO 101
     ALLOCATE(dircodtipo(Nd),dircodelem(Nd),dirCodDato(Nd),dirNumRes(Nd), STAT=er)
     IF (ER.NE.0)  call errorr(100)
     REWIND(idir2)
     DO i=1, Nd
          READ(idir2,*,ERR=101) dircodtipo(i),dircodelem(i),dircoddato(i),dirnumres(i)

          !WRITE(*,*)i,dircodtipo(i),dircodelem(i),dircoddato(i),dirnumres(i)

     END DO

     CLOSE(idir2)
RETURN
101     CONTINUE
        CALL ERRORr(101,0)
        RETURN
END
!
SUBROUTINE leeDatDesagre() ! lectura datos para cálculos ---------
     USE mfiles
     use mdir
     use mg2s
!
     INTEGER,DIMENSION(:),allocatable::g2sCodTipo,g2sCodElem,g2sCodDato,g2scodtipodato,g2sNumRes
     INTEGER::nline,i,er,i2,icd !,fmtDatos=7
     CHARACTER*40::str2
     CHARACTER*1::str1
     OPEN (ig2s,FILE=gistosimges,STATUS='OLD',ERR=101)
! lectura de datos
     NLINE=0
     READ (ig2s,*,END=101)str1
     REWIND (ig2s)
     if (TRIM(str1).eq.'<') THEN !formato etiquetado.
        call errorr(1015)

        titulos_loop:do
          NLINE= NLINE+1
          READ(ig2s,*,END=101)stR2
          select case (TRIM(str2))
            case ('<NUMEROSERIES>')
              nline=nline+1
              READ(ig2s,*,ERR=101,END=101)ng2s
              call errorr(1007,ng2s)
            case ('<G2S_FORMATO>')
              nline=nline+1
              READ(ig2s,*,ERR=101,END=101)fmtDatos
              call errorr(1016,fmtdatos)
			  !if (fmtdatos.gt.20) optDescriptor=1
			  if (fmtdatos.ne.7.) iSALBD=0
            case ('<G2S_CODIGOS>')
              IF (NG2S.GT.0) THEN !DEBE HABER LEÍDO ANTES el <NUMEROSERIES>  ¿qué hago con esto?
                 ALLOCATE(g2sCODIGOS(ng2s), STAT=er)
                 IF (ER.NE.0) call errorr(100)
                 nline=nline+1
                 READ(ig2s,*,ERR=101,END=101)G2SCODIGOS
                ! LEIDOCODIGOS=.TRUE.
              END IF

            case ('<G2S_SERIES>')
              EXIT titulos_loop

          end select
        end do titulos_loop
     else 
       do ! cuenta número de líneas
          READ (ig2s,*,END=20)str2
          NLINE=NLINE+1
!WRITE(*,*)str2
       end do
20     CONTINUE
       Ng2s=NLINE
       call errorr(1007,ng2s)
       REWIND(ig2s)
       nline=0
     end if
     IF (Ng2s<1) GOTO 101
     ALLOCATE(g2scodtipo(ng2s),g2scodelem(ng2s),g2scoddato(ng2s),g2scodgis(ng2s),g2scoef(ng2s), STAT=er)
     IF (ER.NE.0) call errorr(100)
     ALLOCATE(g2scodtipodato(ng2s),g2sidatotabla(ng2s),g2sNumRes(ng2s),g2sTipoDatoG(ng2s), STAT=er)
     IF (ER.NE.0) call errorr(100)
 	 if (fmtdatos.gt.20) ALLOCATE(g2sDescrGIS(ng2s), STAT=er) 
     IF (ER.NE.0) call errorr(100)
     g2snumres=0
     DO i=1, ng2s
       nline=nline+1
       if (fmtdatos.eq.4) then
          READ(ig2s,*,ERR=101) g2scodelem(i),G2SCODDATO(I),g2scodgis(i),g2scoef(i)
       elseif (fmtdatos.eq.24) then
          READ(ig2s,*,ERR=101) g2scodelem(i),G2SCODDATO(I),g2scodgis(i),g2scoef(i),g2sDescrGIS(i)
       ELSEIF(fmtdatos.eq.5) then
          READ(ig2s,*,ERR=101) g2scodelem(i),G2SCODDATO(I),g2sNumRes(i),g2scodgis(i),g2scoef(i)
       ELSEIF(fmtdatos.eq.25) then
          READ(ig2s,*,ERR=101) g2scodelem(i),G2SCODDATO(I),g2sNumRes(i),g2scodgis(i),g2scoef(i),g2sDescrGIS(i)
       elseif(fmtdatos.eq.27) then
          READ(ig2s,*,ERR=101) g2scodtipo(i),g2scodelem(i),G2SCODDATO(I),g2sNumRes(i),g2scodgis(i),g2scoef(i),g2sTipoDatoG(i),g2sDescrGIS(i)
       else !if(fmtdatos.eq.7) then
          READ(ig2s,*,ERR=101) g2scodtipo(i),g2scodelem(i),G2SCODDATO(I),g2sNumRes(i),g2scodgis(i),g2scoef(i),g2sTipoDatoG(i)
		  !WRITE(*,*)g2scodgis(i)
       end if

         ! WRITE(*,*)i,g2scodtipo(i),g2scodelem(i), g2scoddato(i),g2scodgis(i),g2scoef(i)

     END DO
     CLOSE(ig2s)
!! asigna código de tipo resultado (provisional mientras no lo escriba en archivo)
!     do i=1,ng2s
!        select case (g2scodtipo(i))
!            case (50:54)
!                g2scoddato(i)=330+(g2scodtipo(i)-50)*10
!            CASE (12)
!                g2scoddato(i)=322
!            case default
!                call errorr(103)
!        end select
!     end do
!
! identifica índices de datos para cálculo
     loop_g2s: do i=1,ng2s
        icd=g2scodElem(i)
        do i2=1,nd
            if (icd.eq.dircodelem(i2)) then
               if (g2scoddato(i).eq.dircoddato(i2).and.g2snumres(i).eq.dirnumres(i2)) THEN
                  g2sIdatotabla(i)=i2
                  CYCLE loop_g2s
               end if
            end if
        end do
        !IF(I2.GT.nd) THEN 
            CALL ERRORR(107,I)
        !end if    
     end do loop_g2s
RETURN
101     CONTINUE
        CALL ERRORr(102,nline)
        RETURN

END SUBROUTINE
!
subroutine leeCONFIG() ! --------------lectura de datos CONFIGURACION ----------------------------
USE mfiles
CHARACTER(LEN=250)::str1
INTEGER::nline
  OPEN (d1,FILE=datos1,STATUS='OLD',ERR=101)
  call errorr(1001)
  nline=0
  do
     nline=nline+1
     READ(d1,*,ERR=101,END=101)stR1

     select case (TRIM(str1))
!         case ('<ARCHIVOS>')
!           ARCHIVOS:do
!     		nline=nline+1
!     		READ(d1,'(A20)',ERR=102,END=101)stR1
                !WRITE(*,*)STR1
!     		select case (TRIM(str1))
         	   case ('<G2S_TABLATXT>')
                        READ(D1,*)TABLATXT
                        call errorr(1002,0,TABLATXT)
         	   case ('<G2S_TABLADIR2>')
                        READ(D1,*)TABLADIR2
                        call errorr(1003,0,TABLADIR2)
         	   case ('<G2S_GISTOSIMGES>')
                        READ(D1,*)GISTOSIMGES
                        call errorr(1004,0,GISTOSIMGES)
         	   case ('<G2S_TABLA2>')
                        READ(D1,*)TABLA2
                        call errorr(1005,0,TABLA2)
         	   case ('<G2S_FICHBD>')
                        READ(D1,*)RESULTBD
                        call errorr(1011,0,RESULTBD)
         	   case ('<G2S_ANNIO1BD>')
                        READ(D1,*)ANNIO1
                        call errorr(1012,ANNIO1)
!         	   case ('</ARCHIVOS>')
!                        !WRITE(*,*)'PASO POR /ARCHIVOS'
!                        EXIT ARCHIVOS
!                   case default
!                end select
!           end do ARCHIVOS
! 102       continue

!         CASE ('<OPCIONES>')
!           OPCIONES:do
!     		nline=nline+1
!     		READ(d1,*,ERR=103,END=101)stR1
!     		select case (TRIM(str1))
                   CASE ('<G2S_SEPARADOR>')
                        READ(D1,*)I1
                        CHSEP=CHAR(I1)
                        call errorr(1006,I1,CHSEP)
                   CASE ('<G2S_DELIMITADOR>')
                        READ(D1,*)I1
                        CHDEL=CHAR(I1)
                        call errorr(1006,I1,CHDEL)
                   case ('<G2S_OPCIONBD>')
                        READ(D1,*)iSALBD
                        IF (isalbd.eq.1.or.isalbd.eq.0) call errorr(1013,isalbd)
                   case ('<G2S_ECODETALLE>')
                        READ(D1,*)IDETALLE
                   case ('<G2S_CIERRAFIN>')
                        READ(D1,*)ICODFIN !SI =1 CIERRA LA VENTANA AL TERMINAR

 !        	   case ('</OPCIONES>')
 !                       EXIT OPCIONES
 !                  case default
 !               end select
 !          end do OPCIONES
 !103       continue
         case default
     end select
  END do
  CLOSE(d1)
101     CONTINUE
RETURN
end subroutine
!
! ---------------------------------------tratamiento errores-----------------------------------------------
subroutine errorr(ierr,n1,TXT) !mensajes por pantalla o donde sea
! SI EL CÓDIGO ES MENOR DE 1000 ES UN ERROR Y EL PROGRAMA SE PARA.
! SI EL CÓDIGO ES MAYOR DE 1000 ES UN MENSAJE PARA PANTALLA Y CONTINUA.
 INTEGER,INTENT(IN)::ierr,n1
 CHARACTER(LEN=*),INTENT(IN)::TXT
 select case (ierr)
    case (100)
        WRITE(*,*)'Problemas con la memoria de variables'
    case (101)
        WRITE(*,*)'Error en archivo datos salida simges: tabla.dir2'
    case (102)
        WRITE(*,*)'Error en archivo datos datos para cálculos: gistosimges.txt. Línea ',n1
    case (103)
        WRITE(*,*)'Tipo de dato no programado'
    case (104)
        WRITE(*,*)'error archivo serie datos: tabla.txt'
    case (105)
        WRITE(*,*)'Error lectura datos tabla.txt. Línea ',n1
    case (106)
        WRITE(*,*)'Error abriendo archivo salida resultados. Tabla2.txt '
    CASE (107)
        WRITE(*,*)'Error, no encuentra datos para la serie en la posición ', n1
    ! Mensajes sin error
    case (1000)
        WRITE(*,*)'PROGRAMA PARA LA LECTURA DE ARCHIVO RESULTADOS SIMGES'
        WRITE(*,*)'Y EL CÁLCULO DE LOS MISMOS PARA DATOS SELECCIONADOS.'
        WRITE(*,*)'CASO DE CÁLCULO RESULTADOS DERIVADOS PARA MASAS DE AGUA.'
        WRITE(*,*)'            version 2.0.'
    case (1001)
        WRITE(*,*)'Lectura archivo datos generales.'
    case (1002)
        WRITE(*,*)'.... Resultados de SIMGES: ',TRIM(TXT)
    case (1003)
        WRITE(*,*)'.... Códigos de datos de SIMGES: ',TRIM(TXT)
    case (1004)
        WRITE(*,*)'.... Definición salida resultados:  ',TRIM(TXT)
    case (1005)
        WRITE(*,*)'.... Archivo para resultados: ',TRIM(TXT)
    case (1006)
        WRITE(*,*)'.... Seleccionado separador datos: Código: ',n1,' = ',TRIM(TXT)
    case (1007)
        WRITE(*,*) 'Resultados a extraer ',n1
    case (1008)
        WRITE(*,*)'Series de datos SIMGES ',n1
    case (1009)
        WRITE(*,*)'PROCESO TERMINADO '
    case (1010)
        WRITE(*,*)'Calculando ..... '
    case (1011)
        WRITE(*,*)'.... Archivo para resultados en formato BD: ',TRIM(TXT)
    case (1012)
        WRITE(*,*)'.... Año inicio para resultados en formato BD',n1
    case (1013)
        WRITE(*,*)'.... Opcion escritura de resultados en formato BD',n1
    case (1014)
        WRITE(*,*)'.... Seleccionado delimitador de textos: Código: ',n1,' = ',TRIM(TXT)
    case (1015)
        WRITE(*,*)'Archivo de datos etiquetado'
    case (1016)
        WRITE(*,*)'.... Series con datos ',n1

    case default
        WRITE(*,*)ierr
 end select
 if (ierr.lt.1000) call fin()
RETURN
end subroutine
!
subroutine fin() !termina programa
USE MFILES,ONLY:ICODFIN
IF (ICODFIN.EQ.1) THEN
   STOP
ELSE
   PAUSE
   STOP
END IF
end subroutine
!
