!################################################################################ !# # !# DATELIB # # !# # !# MODULO DE FUNCOES PARA PROCESSAR DATA E HORAS EM FORTRAN 90 # !# # !# Copyright (C) 2004 Sergio Henrique S. Ferreira # !# # !# MCT-INPE-CPTEC-Cachoeira Paulista, Brasil # !# # !#------------------------------------------------------------------------------# !# Tipo : MODULO DE USO GERAL (FORTRAN 90) # !# Dependencias: NAO HA # !#------------------------------------------------------------------------------# !# Descricao: # !# # !# Este modulo contem subrotinas para trabalhar com data e hora em fortran # !# Neste modulo chama-se data-hora variaveis do tipo REAL*8 que representam # !# a data no calendario juliano em dias e fraçoes de dias # !# Atraves das funcoes disponiveis neste modulo e posivel converter data # !# do calendario gregoriano para juliano e vice e versa # !# # !# A conversao para calendario juiano (jdate) permite operar aritimeticamente # !# com estes valores, sem ser necessario a preocupacao com as "viradas" # !# de mes e ano # !#------------------------------------------------------------------------------# !# FUNCOES PUBLICAS # !# fjulian : Retorna real*8 que representa a data do calendario juliano # !# a partir do dia 1 de janeiro do ano zero em # !# dias e fracoes de dias # !# # !# # !# # !# # !# year(jdate) : Retorna inteiro que representa o ano # !# month(jdate): Retorna inteiro que representa o mes # !# day (jdate) : Retorna inteiro que representa o dia # !# hour (jdate): Retorna inteiro que representa a hora # !# minute(jdate): Retorna inteiro que representa os minutos # !# grdate(jdate): Retorna caracter *19 que corresponde a data # !# no calendario gregoriano,em formato utilizado # !# pelo programa Grads # !# # !# Notas: # !# a) Para converter uma data do calendario gregoriano para juliano pode # !# ser utilizado um dos dois modos seguintes: # !# # !# jdate=fjulian(iyear,imonth, iday,ihour,iminute) # !# # !# # !# jdate=fjulian("yyyymmddhhnn") # !# # !# b) jdate eh real*8 que representa a data do calendario juliano # !# a partir do ano 0 em dias e fracoes de dias # !# # !# c) Sao validas todas as operacoes matematicas sobre jdate # !# Exemplo 1 : Para somar um dia a jdate: jdate = jdate + 1.0 # !# Exemplo 2 : Para subtrair 12 horas de jdate: jdate = jdate - 0.5 # !# # !# d) Para retornar ao calendario gregoriano use as funcoes apropriadas # !# (year,month,day,hour,minute) # !# # !# # !# Conversoes para outras datas # !# # !# # !# SOFTWARE VALOR DE CONVERSAO # !# ------------------ ------------------ # !# De VB para datelib: + 693975 # !################################################################################ !# REVISAO HISTORICA # !# # !# 2004 - VERSAO 1.0 - SERGIO HENRIQUE S. FERREIRA # !# 11/11/2005 - SERGIO H. - Reduzido erro de precisao na funcao fjulian1 # !# da subrotina fjulian1 devido a conversao de horas, # !# minutos e segundos em dia. O problema da precisao # !# ainda existe e eh de aproximadamente -1 minuto # !################################################################################ # MODULE DATELIB type tpmonth integer::nm end type type(tpmonth),DIMENSION(12)::monthy PRIVATE fjulian1 PRIVATE fjulian2 PRIVATE init !#==============================================================================# !# FJULIAN SHSF # !#------------------------------------------------------------------------------# !# Tipo : INTERFACE PUBLIC # !#------------------------------------------------------------------------------# !# Descricao: # !# Esta inteface retorna o dia juliano a partir do ano 0 em dias e fracoes de # !# dias. # !# # !# Formas de entrada: # !# A) Varaiavel caracter "YYYYMMDDHH" # !# B) Variaveis inteiras (ano, mes, dia, hora,minutos, segundos) # !# # !#------------------------------------------------------------------------------# interface fjulian module procedure fjulian1 module procedure fjulian2 end interface CONTAINS !#==============================================================================# !# INIT - SUB-ROTINA PARA INICIALIZACAO DO MODULO DATELIB SHSF # !#------------------------------------------------------------------------------# !# Tipo : SUBROTINA DE ACESSO PRIVADO # !# Dependencias : # !#------------------------------------------------------------------------------# !# Descricao: # !# Esta subrotina inicializa o vetor do dias do mes (monthy) conforme # !# o dia do ano # !# # !#------------------------------------------------------------------------------# subroutine init(year) !{ Variaveis de interface integer,intent(in)::year ! Ano !} monthy(1)%nm=31 !'jan monthy(2)%nm=28 !'fev monthy(3)%nm=31 ! 'mar monthy(4)%nm=30 ! 'apr monthy(5)%nm=31 ! 'may monthy(6)%nm=30 ! 'jun monthy(7)%nm=31 ! 'jul monthy(8)%nm=31 ! 'ago monthy(9)%nm=30 ! 'sep monthy(10)%nm=31 !'oct monthy(11)%nm=30 ! 'nov monthy(12)%nm=31 !'dec if (mod(year,4)==0) monthy(2)%nm=29 end subroutine !#==============================================================================# !# FJULIAN1 SHSF # !#------------------------------------------------------------------------------# !# # !# Esta funcao retorna o dia juliano a partir do ano 0 em dias e fracoes de # !# dias. Entrada sao variaveis interiras que representam ano,mes,dia, hora e # !# minutos (calendario gregoriano) # !# # !#------------------------------------------------------------------------------# !# FUNCAO REAL *8 de acesso PRIVATIVO, acessado pela INTERFACE PUBLICA FJULIAN # !# DEPENDENCIAS: SUBROTINA INIT # !#------------------------------------------------------------------------------# function fjulian1(year,month,day,hour,min,sec); real*8::fjulian1 !{ Variaveis de interface integer,intent(in)::year,month,day,hour,min,sec !} !{ Variaveis locais real*8 d,a_hour,a_day,a_min !} if ((month<1).or.(month>12)) then print *, Erro! Invalid date in datelib fjulian1=0 return end if d=0;h=0;a_day=0;a_min=0;a_hour=0 call init(year) do i=0,(year-1),4 d=d+1 end do d=d+365*year do i=2,month,1 d=d+monthy(i-1)%nm end do a_min=real(min)+real(sec)/60.0 a_hour=real(hour)+a_min/60.0 a_day=real(day)+a_hour/24.0 d=d+a_day if (d>0) then fjulian1 =d else print *,"Erro in DATELIB: Invalid date =",d stop end if end function !#==============================================================================# !# FJULIAN2 SHSF # !#------------------------------------------------------------------------------# !# Tipo : FUNCAO REAL *8 de acesso PRIVATIVO # !# Acessado por : INTERFACE PUBLICA FJULIAN # !# Dependencias : SUBROTINA INIT, SUBROTINA FJULIAN1 # !#------------------------------------------------------------------------------# !# Descricao: # !# Esta funcao retorna o dia juliano a partir do ano 0 em dias e fracoes de # !# dias. A entrada é uma variavel caracter do tipo "yyyymmddhhnn" onde: # !# yyyy = ano, mm = mes, dd=dia, hh=hora, nn = minutos # !# # !#------------------------------------------------------------------------------# function fjulian2(SDATES) real*8:: fjulian2 real*8:: cdate character(len=*),intent(in)::SDATES ! Data no formato YYYYMMDDHHmmss integer :: ANO,MES,DIA,HORA,MIN,SEG read(SDATES,'(I4,I2,I2,I2,I2,I2)')ANO,MES,DIA,HORA,MIN,SEG cdate=fjulian1(ANO,MES,DIA,HORA,MIN,SEG) fjulian2=cdate end function fjulian2 !#==============================================================================# !# GRDATE SHSF # !#------------------------------------------------------------------------------# !# Tipo : FUNCAO CHARACTER(LEN=19) de acesso PUBLICO # !# Dependencias: funcoes: Year,month,day,hour # !#------------------------------------------------------------------------------# !# Descrição: # !# # !# Retorna um texto que representa a data no formato (hh:mnZ ddmmmyyyy)", # !# utilizado nos arquivos descritores do grads # !# # !# Sintax: cdate=grdate(jdate) # !# # !# jdate: Ver definicao no inicio do modulo # !# # !# # !#------------------------------------------------------------------------------# function grdate(jdate);character(len=19)::grdate real*8,intent(in)::jdate character(len=3),dimension(12)::nm character(len=19)::a integer :: i nm(1)="Jan" nm(2)="Feb" nm(3)="Mar" nm(4)="Apr" NM(5)="May" nm(6)="Jun" nm(7)="Jul" nm(8)="Aug" nm(9)="Sep" nm(10)="Oct" nm(11)="Nov" nm(12)="Dec" i=month(jdate) write(a,10)hour(jdate),day(jdate),nm(i),year(jdate) 10 format(i2.2,":00Z",i2.2,a3,i4) grdate=a end function !#==============================================================================# !# year(jdate) SHSF # !#------------------------------------------------------------------------------# !# Tipo : FUNCAO INTEGER de acesso PUBLICO # !# Dependencias: funcoes: fjulian # !#------------------------------------------------------------------------------# !# Descrição: # !# # !# Funcao que retorna o valor do ano (inteiro) de uma data juliana (real*8) # !# # !# Sintax: iyear=year(jdate) # !# # !#------------------------------------------------------------------------------# function year(d) integer::year real*8,intent(in)::d integer::y real*8::d2 y=-1 10 y=y+1 d2=fjulian(y,1,1,0,0,0) if (d2<=d) goto 10 year=y-1 end function !#==============================================================================# !# month(jdate) SHSF # !#------------------------------------------------------------------------------# !# Tipo : FUNCAO INTEGER de acesso PUBLICO # !# Dependencias: funcoes: fjulian, year # !#------------------------------------------------------------------------------# !# Descrição: # !# # !# Funcao que retorna o valor do mes (inteiro de 1 a 12) de uma data juliana # !# # !# Sintax: imonth=month(jdate) # !# # !#------------------------------------------------------------------------------# function month(d) integer :: month real*8,intent(in)::d real*8::d2 integer :: y,m y=year(d) m=0 10 m=m+1 d2=fjulian(y,m,1,0,0,0) if (d2<=d) goto 10 month=m-1 end function !#==============================================================================# !# day(jdate) SHSF # !#------------------------------------------------------------------------------# !# Tipo : FUNCAO INTEGER de acesso PUBLICO # !# Dependencias: funcoes: fjulian, year,month # !#------------------------------------------------------------------------------# !# Descrição: # !# # !# Funcao que retorna o valor do dia (inteiro de 1 a 31) de uma data juliana # !# # !# Sintax: iday=day(jdate) # !# # !#------------------------------------------------------------------------------# function day(d) integer :: day real*8,intent(in)::d real*8::d2 integer :: y,m,a y=year(d) m=month(d) a=0 10 a=a+1 d2=fjulian(y,m,a,0,0,0) if (d2<=d) goto 10 day=a-1 end function !#==============================================================================# !# hour(jdate) SHSF # !#------------------------------------------------------------------------------# !# Tipo : FUNCAO INTEGER de acesso PUBLICO # !# Dependencias: # !#------------------------------------------------------------------------------# !# Descrição: # !# # !# Funcao que retorna a hora (inteiro de 0 a 23) de uma data juliana # !# # !# Sintax: ihour=hour(jdate) # !# # !#------------------------------------------------------------------------------# function hour(d) integer :: hour real*8,intent(in)::d hour=int((d -int(d ))*24) end function END MODULE