!-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! !BOI ! ! !TITLE: Input/Output BAM interface Documentation \\ Version 1.0.0 ! ! !AUTHORS: João Gerd Zell de Mattos ! ! !AFFILIATION: Modeling and Development Division, CPTEC/INPE ! ! !DATE: October 11, 2016 ! ! !INTRODUCTION: ! Input/Output BAM interface (sigio\_BAMMod) is a Fortran 90 collection of ! routines/functions for accessing the forecasting data files of the ! Brazilian Global Atmospheric Model (BAM) in spectral format. ! ! \subsection{BAM data files} ! ! Os arquivos de previsão do modelo BAM são constituídos por dois arquivos em ! formatos distintos: ! \begin{enumerate} ! \item Um arquivo no formato ASCII, denominado arquivo {\bf dir} contém um ! cabeçalho descrevendo algumas informações da simulação, tais ! como: (a) data inicial e final da simulação, (b) número de níveis ! verticais e (c) delta Z entre os níveis verticais. Este arquivo também ! possui uma tabela contendo as variáveis disponíveis no arquivo de ! previsão, identificando o tipo de cada variável ! (Diagnostica/Prognóstica), a quantidade de níveis verticais e se é ! uma variável em ponto de grade ou em formato spectral; ! \item Um arquivo no formato `IEEE', denominado arquivo {\bf fct} que contém um ! cabeçalho com a data da simulacão, seguido pelos campos diagnosticos e ! prognosticos do modelo BAM. Estes campos estão na mesma sequência em que ! aparecem na tabela de variáveis do aquivo {\bf dir} \\ ! {\bf NOTA:} um arquivo no formato `IEEE' é refenciado como um ! arquivo fortran não formatado (``unformatted'') com acesso sequencial ! e com o comprimento dos registros variável. No sistema Linux/Unix comum, é ! apenas um arquivo com registros utilizando palavras de 4 bytes e um ! ``cabecalho'' de 4 bytes indicando o tamanho do registro em bytes. ! \end{enumerate} ! ! \newpage ! \subsection{Principais Rotinas/Funções} ! ! \begin{verbatim} ! ------------------------+----------------------------------------- ! Routine/Function | Description ! ------------------------+----------------------------------------- ! | ! BAM_Open | Open a BAM file ! BAM_Close | Close a BAM file ! BAM_GetField | Return a BAM field from a file ! BAM_GetOneDim | Return just one of 4 BAM field dimensions ! BAM_GetDims | Return BAM field dimensions ! BAM_GetNlevels | Return the number of leves of a field ! BAM_GetVerticalCoord | Return information about vertical coordinate ! BAM_GetWCoord | Return BAM world coordinates ! BAM_GetHeadInfo | Read BAM fct file header informations ! BAM_GetTimeInfo | Return time info ! BAM_WriteAnlHeader | Write the Anl file header ! BAM_WriteField | Write a BAM field (mpi or serial) ! BAM_SendField | if mpi code is used to send a field to write ! | ! ------------------------+----------------------------------------- ! \end{verbatim} ! ! \subsection{Exemplo de uso} ! ! O primeiro passo é carregar este módulo no programa fortran e definir uma estrutura ! de dados contendo as informações do BAM. ! ! \begin{enumerate} ! ! \item Defina no início do programa fortran o uso do módulo sigio\_BAMMod: ! ! \begin{verbatim} ! use sigio_BAMMod ! \end{verbatim} ! ! \item Defina uma variável que conterá a estrutura de dados: ! ! \begin{verbatim} ! type(BAMFile) :: BAM_struc ! \end{verbatim} ! ! \item Defina qual o arquivo deverá ser lido (fct,dir,anl). Os arquivos do bam são ! compostos por um arquivo de cabecalho (dir) e um arquivo binario (fct/anl): ! ! \begin{verbatim} ! BAM_struct%fdir = GFCTNMC20131231002013123106F.dir.TQ0062L028 ! BAM_struct%ffct = GFCTNMC20131231002013123106F.fct.TQ0062L028 ! \end{verbatim} ! ! \item Utilize a rotina específica para a abertura do arquivo: ! ! \begin{verbatim} ! ! call BAM_Open(BAM_struc, iret) ! ! \end{verbatim} ! ! \item Faça a leitura do campo disponível no BAM, defina antes o nome da ! variável, o nível vertical e aloque um vetor do tamanho necessário para ! retornar o campo solicitado: ! ! \begin{verbatim} ! ! Allocate(grid(192*96)) ! ! VName = `VIRTUAL TEMPERATUE' ! ilev = 1 ! ! call BAM_GetField(BAM_struc, trim(VName(ivar)), ilev, grid, iret) ! ! \end{verbatim} ! ! \item Depois que forem lidos todos os campos necessários do modelo BAM feche o arquivo: ! ! \begin{verbatim} ! call BAM_Close(BAM_struc) ! \end{verbatim} ! ! \end{enumerate} ! !Veja os prólogos na próxima seção para obter detalhes adicionais. ! !EOI ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! ! Module sigio_BAMMod use MPI use Fourier, only: InitFFT, ClsMemFFT use legendre, only: InitLegendre, ClsMemLegendre use recomposition, only: InitRecomposition, ClsMemRecomposition, & RecompositionScalar, RecompositionVector, & DivgVorttoUV use decomposition, only: InitDecomposition, ClsMemDecomposition,& DectoSpherHarm, UVtoDivgVort, TransSpherHarm implicit none Private ! ! !PARAMETERS: ! ! !precisao dos dados do modelo BAM integer, public, parameter :: I4 = SELECTED_INT_KIND(9) ! Kind for 32-bits Integer Numbers integer, public, parameter :: I8 = SELECTED_INT_KIND(14) ! Kind for 64-bits Integer Numbers integer, public, parameter :: R4 = SELECTED_REAL_KIND(6) ! Kind for 32-bits Real Numbers integer, public, parameter :: R8 = SELECTED_REAL_KIND(15) ! Kind for 64-bits Real Numbers integer, public, parameter :: strlen = 1024 !Logical Units integer, parameter :: stderr = 0 ! Error Unit integer, parameter :: stdinp = 5 ! Input Unit integer, parameter :: stdout = 6 ! Output Unit ! Constants real, parameter :: rd = 45_r8/ATAN(1.0_r8) ! convert to radian ! MPI Parameters integer :: MPITag = 100 integer :: status(MPI_Status_size) ! BAM header structure type BAM_head character (len = 20) :: ittl character (len = 40) :: specal character (len = 41) :: jttl character (len = 4) :: sdain character (len = 4) :: dtin character (len = 5) :: trunc integer (I4) :: nexp integer (I4) :: mMax integer (I4) :: mnwv2 integer (I4) :: imax integer (I4) :: jmax integer (I4) :: kmax integer (I4) :: ihr, idy, imo, iyr integer (I4) :: fhr, fdy, fmo, fyr ! sigma levels real (r8), dimension (:), pointer :: delSig real (r8), dimension (:), pointer :: SigInt real (r8), dimension (:), pointer :: SigMid ! lat/lon iformations real(r4), dimension(:), pointer :: rlon ! real longitude real(r4), dimension(:), pointer :: clon ! rlon cosine real(r4), dimension(:), pointer :: slon ! rlon sine real(r4), dimension(:), pointer :: rlat ! real latitude real(r4), dimension(:), pointer :: clat ! rlat cosine real(r4), dimension(:), pointer :: slat ! rlat sine end type ! BAM fields structure type BAM_fld character (len = 40) :: Name ! Long field Name character (len = 4) :: ProDia! Prognostig / Diagnostic integer (I4) :: nharm ! variable array size integer (I4) :: nlevs ! variable # of levs integer (I4) :: fldunit real (r4), allocatable :: grid(:,:,:) type(BAM_fld), pointer :: next => null() end type ! BAM data type structure type, public :: BAMFile character(len=strlen) :: fanl ! Anl file name character(len=strlen) :: ffct ! fct file name character(len=strlen) :: fdir ! dir file name (header informations) integer (I4) :: uanl ! Anl file opened unit integer (I4) :: ufct ! fct file opened unit integer (I4) :: udir ! dir file opened unit type(BAM_head) :: head ! header informations (see BAM_Head type) type(BAM_fld), pointer :: root => null() type(BAM_fld), pointer :: flds => null() integer (I4) :: fcount end type ! ! !PUBLIC MEMBER FUNCTIONS: ! public :: BAM_Open ! Open a BAM file public :: BAM_Close ! Close a BAM file public :: BAM_GetField ! Read BAM field from a file public :: BAM_GetOneDim ! Return just one of 4 BAM field dimensions public :: BAM_GetDims ! Return BAM field dimensions public :: BAM_GetNlevels ! Return the number of leves of a field public :: BAM_GetSigValues public :: BAM_GetVerticalCoord public :: BAM_GetWCoord ! Return BAM world coordinates public :: BAM_GetHeadInfo ! Read BAM fct file header informations public :: BAM_GetTimeInfo ! Return time info public :: BAM_WriteAnlHeader ! Write the Anl file header public :: BAM_WriteField ! Write a BAM field (mpi or serial) public :: BAM_SendField ! if mpi code is used to send a field to write public :: BAM_GetAvailUnit interface BAM_GetHeadInfo module procedure ReadHead_ end interface interface BAM_GetField module procedure SGetFLD_1d, SGetFLD_2d, & DGetFLD_1d, DGetFLD_2d, & ReadFLDS_ end interface interface ReadField module procedure SRead1D_, SRead2D_, SRead3D_, & DRead1D_, DRead2D_, DRead3D_, & SkipRead_ end interface interface BAM_WriteField module procedure WriteField_MPI, WriteField_Serial end interface interface perr module procedure perr1_ end interface interface BAM_GetAvailUnit module procedure GetAvailUnit end interface ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. Z. de Mattos - Initial Version ! !-----------------------------------------------------------------------------! contains !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: BAM_Open - routine used to open BAM type files for read and ! write purposes. ! ! ! !DESCRIPTION: Esta rotina é uma interface para abrir os arquivos ! do modelo BAM. Há dois modos para a abertura dos aquivos do BAM, ! um somente leitura e outro para escrita. No modo somente ! leitura, caso não seja definido explicitamente qual o arquivo ! que deve ser lido, abre-se por padrão os arquivos necessários ! para a leitura do arquivo de previsão, ou seja, abre o arquivo ! DIR e o arquivo FCT. O arquivo DIR serve como um arquivo ! descritor que indica qual a posicão de cada variável dentro do ! arquivo FCT. Já no modo de escrita, caso não seja especificado, ! abre-se somente o arquivo de condicão inicial do BAM. No modo de ! escrita, caso o arquivo já exista ele é sobrescrito pelo novo ! arquivo. ! ! ! !INTERFACE: ! subroutine BAM_Open(BFile, mode, ftype, istat) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(inout) :: BFile ! Open mode: R - read-only; W - Write character(len=*), intent(in ) :: mode ! File type: dir, fct, anl character(len=*), optional, intent(in ) :: ftype ! Can be: ! 1. dir: descriptor BAM file ! 2. fct: forecast BAM file ! 3. anl: initial condition BAM file ! ! At Read-only mode default ftype is to open dir and fct together ! At Write mode default ftype is to open anl file only ! ! ! !OUTPUT PARAMETERS: ! integer, optional, intent( out) :: istat ! ! !SEE ALSO: ! ! Open_( ) interface to open each type of BAM file ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: BAM_Open( ... )' character(len=1) :: md integer :: iret, iret0, iret1 integer :: IMax, JMax if(present(istat))istat = 0 md = ucase(mode) select case (md) case ('R') if(present(ftype))then call Open_(BFile, mode, ftype, iret) if(present(istat))istat = iret else if(trim(Bfile%ffct).ne.''.and.trim(Bfile%fdir).ne.'')then #ifdef VERBOSE write(stdout,'(A)')'Opening default BAM file to read: DIR and FCT files' #endif call Open_(BFile, mode, 'fct', iret0) call Open_(BFile, mode, 'dir', iret1) iret = min(iret0,iret1) if(present(istat))istat = iret else write(stdout,'(2(1x,A))')trim(myname_),' error : Undefined ftype, try open default files.' write(stdout,'( A )')'' write(stdout,'(1(1x,A))')'Default files to read-only open type are DIR and FCT file,' write(stdout,'(1(1x,A))')'but ffct and dir names are undefined!' write(stdout,'( A )')'' write(stdout,'(1(1x,A))')'use ftype= :' write(stdout,'(1(1x,A))')' : to read anl file' write(stdout,'(1(1x,A))')' : to read fct file' write(stdout,'(1(1x,A))')' : to read dir file' write(stdout,'( A )')'' write(stdout,'(1(1x,A))')'define file name:' write(stdout,'(1(1x,A))')' : Name of anl file' write(stdout,'(1(1x,A))')' : Name of fct file' write(stdout,'(1(1x,A))')' : Name of dir file' if(present(istat))istat = -1 endif endif case ('W') if(present(ftype))then call Open_(BFile, mode, ftype, iret) if(present(istat))istat = iret else if(trim(Bfile%fanl).ne.'')then #ifdef VERBOSE write(stdout,'(A)')'Opening default BAM file to write: ANL file' #endif call Open_(BFile, mode, 'anl', iret) if(present(istat))istat = iret else write(stdout,'(2(1x,A))')trim(myname_),' error : Undefined ftype, try open default files.' write(stdout,'( A )')'' write(stdout,'(1(1x,A))')'Default files to write open type is ANL file,' write(stdout,'(1(1x,A))')'but anl file name is undefined!' write(stdout,'( A )')'' write(stdout,'(1(1x,A))')'use ftype= :' write(stdout,'(1(1x,A))')' : to write anl file' write(stdout,'(1(1x,A))')' : to write fct file' write(stdout,'(1(1x,A))')' : to write dir file' write(stdout,'( A )')'' write(stdout,'(1(1x,A))')'define file name:' write(stdout,'(1(1x,A))')' : Name of anl file' write(stdout,'(1(1x,A))')' : Name of fct file' write(stdout,'(1(1x,A))')' : Name of dir file' if(present(istat))istat = -1 endif endif case default write(*,'(3(1x,A))')trim(myname_),': Unknown mode type:',trim(mode) write(*,'(2(1x,A))')trim(myname_),': use for write and for read' if(present(istat))istat = -1 end select end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: Open_ - routine that call low level routines to open each type ! of BAM files ! ! ! !DESCRIPTION: Esta rotina é uma interface para abrir os arquivos ! do modelo BAM. Há dois modos para a abertura dos aquivos do BAM: ! (1) somente leitura e (2) escrita. Em ambos os casos é ! necessário informar qual o tipo do arquivo que se está querendo ! ler ou escrever. Há três tipos de dados: (1) arquivos de ! previsão (FCT), (2) arquivos de condicão inicial (ANL) e (3) arquivos ! descritores (DIR). O arquivo DIR serve como um arquivo ! descritor que indica qual a posicão de cada variável dentro do ! arquivo FCT. É importante salientar que no modo de escrita, ! caso o arquivo já exista ele é sobrescrito pelo novo arquivo. ! ! ! !INTERFACE: ! subroutine Open_(BFile, mode, ftype, istat) USE InputParameters, ONLY: InitParameters, & Imax, Jmax, Kmax, & mnwv2, Mend, & flon, flat implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(inout) :: BFile ! Open mode: R - read-only; W - Write character(len=*), intent(in ) :: mode ! File type: dir, fct, anl character(len=*), intent(in ) :: ftype ! Can be: ! 1. dir: descriptor BAM file ! 2. fct: forecast BAM file ! 3. anl: initial condition BAM file ! ! ! !OUTPUT PARAMETERS: ! integer, optional, intent( out) :: istat ! ! !SEE ALSO: ! ! OpenAnl_( ) interface to open ANL BAM file ! OpenFCT_( ) interface to open FCT BAM file ! OpenDIR_( ) interface to open DIR BAM file ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = 'Open_( ... )' integer :: iret character(len=1024) :: ftype_name character(len=1024) :: ftype_mode if(present(istat))istat = 0 ftype_name = ucase(ftype) ftype_mode = ucase(mode) select case(trim(ftype_name)) case('ANL')! BAM anl file call OpenAnl_( BFile, trim(ftype_mode), iret) if (iret .ne. 0 )then if(present(istat)) istat = iret return endif case('FCT')! BAM fct file call OpenFct_( BFile, trim(ftype_mode), iret) if (iret .ne. 0 )then if(present(istat)) istat = iret return endif case('DIR')! BAM dir file call OpenDir_( BFile, trim(ftype_mode), iret) if (iret .ne. 0 )then if(present(istat)) istat = iret return endif call ReadHead_(BFile,iret) if (iret .ne. 0)then write(6,'(A,1x,A,I3)')trim(myname_),' error to get Header of BAM file', iret if(present(istat))istat = iret return endif end select end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: OpenAnl_ - routine that call low level routines to open ANL type ! of BAM files ! ! ! !DESCRIPTION: Esta rotina é uma interface para abrir os arquivos ! de análise do modelo BAM. Há dois modos para a abertura dos aquivos: ! (1) somente leitura e (2) escrita. É importante salientar que no ! modo de escrita, caso o arquivo já exista ele é sobrescrito pelo ! novo arquivo. ! ! ! !INTERFACE: ! subroutine OpenAnl_( BFile, mode, istat ) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(inout) :: BFile ! Open mode: R - read-only; W - Write character(len=*), intent(in ) :: mode ! ! !OUTPUT PARAMETERS: ! integer, optional, intent( out) :: istat ! ! -80 : File not found ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = 'OpenAnl_ ( ... )' logical :: existe integer :: iret character(len=1) :: md #ifdef DEBUG WRITE(stdout,'( 2A)')'Hello from ', trim(myname_) #endif if(present(istat))istat=0 inquire(file=trim(BFile%fanl),exist=existe) md = ucase(mode) select case (trim(md)) case ('R') if(.not.existe)then iret = -80 write(6,'(A,1x,A,1x,A)')'BAM error =>',trim(myname_),& 'Model file not found : '//trim(BFile%fanl) if(present(istat))istat=iret return endif !Get next available logical unit BFile%uanl = BAM_GetAvailUnit( ) open( unit = BFile%uanl, & file = trim(BFile%fanl), & status = 'unknown', & form = 'unformatted', & action = 'read', & iostat = iret & ) case ('W') if(existe)then write(6,'(A,1x,A,1x,A)')'BAM warning =>',trim(myname_),& 'Model File Already Exists : '//trim(BFile%fanl) write(6,'(A)')'Overwriting existing file!' endif !Get next available logical unit BFile%uanl = BAM_GetAvailUnit( ) open( unit = BFile%uanl, & file = trim(BFile%fanl), & status = 'unknown', & form = 'unformatted', & action = 'write', & iostat = iret & ) end select if (iret.ne.0)then write(6,'(A,1x,A,1x,A,1x,I3)')'BAM error =>',trim(myname_),& 'Error to open model file: '//trim(BFile%fanl),iret if(present(istat))istat=iret return endif endsubroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: OpenFct_ - routine that call low level routines to open FCT type ! of BAM files ! ! ! !DESCRIPTION: Esta rotina é uma interface para abrir os arquivos ! de previsão do modelo BAM. Há dois modos para a abertura dos aquivos: ! (1) somente leitura e (2) escrita. É importante salientar que no ! modo de escrita, caso o arquivo já exista ele é sobrescrito pelo ! novo arquivo. ! ! ! !INTERFACE: ! subroutine OpenFct_( BFile, mode, istat ) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(inout) :: BFile ! Open mode: R - read-only; W - Write character(len=*), intent(in ) :: mode ! ! !OUTPUT PARAMETERS: ! integer, optional, intent( out) :: istat ! ! -80 : File not found ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = 'OpenFct_( ... )' logical :: existe integer :: iret character(len=1) :: md #ifdef DEBUG WRITE(stdout,'( 2A)')'Hello from ', trim(myname_) #endif if(present(istat)) istat = 0 inquire(file=trim(BFile%ffct),exist=existe) md = ucase(mode) select case (trim(md)) case ('R') if(.not.existe)then iret = -80 write(6,'(A,1x,A,1x,A)')'BAM error =>',trim(myname_),& 'Model file not found : '//trim(BFile%ffct) if(present(istat))istat=iret return endif !Get next available logical unit BFile%ufct = BAM_GetAvailUnit( ) open( unit = BFile%ufct, & file = trim(BFile%ffct), & status = 'old', & form = 'unformatted', & action = 'read', & iostat = iret & ) case ('W') if(existe)then write(6,'(A,1x,A,1x,A)')'BAM error =>',trim(myname_),& 'Model File Already Exists : '//trim(BFile%ffct) write(6,'(A)')'Overwriting existing file!' endif !Get next available logical unit BFile%ufct = BAM_GetAvailUnit( ) open( unit = BFile%ufct, & file = trim(BFile%ffct), & status = 'new', & form = 'unformatted', & action = 'write', & iostat = iret & ) end select if (iret.ne.0)then write(6,'(A,1x,A,1x,A,1x,I3)')'BAM error =>',trim(myname_),& 'Error to open model file: '//trim(BFile%ffct),iret if(present(istat))istat=iret return endif endsubroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: OpenDir_ - routine that call low level routines to open DIR type ! of BAM files ! ! ! !DESCRIPTION: Esta rotina é uma interface para abrir os arquivos ! descritores (DIR) do modelo BAM. Há dois modos para a abertura ! dos aquivos: (1) somente leitura e (2) escrita. É importante ! salientar que no modo de escrita, caso o arquivo já exista ele ! é sobrescrito pelo novo arquivo. ! ! ! !INTERFACE: ! subroutine OpenDir_( BFile, mode, istat ) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(inout) :: BFile ! Open mode: R - read-only; W - Write character(len=*), intent(in ) :: mode ! ! !OUTPUT PARAMETERS: ! integer, optional, intent( out) :: istat ! ! -80 : File not found ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = 'OpenDir_( ... )' logical :: existe integer :: iret character(len=1) :: md #ifdef DEBUG WRITE(stdout,'( 2A)')'Hello from ', trim(myname_) #endif if(present(istat)) istat = 0 inquire(file=trim(BFile%fdir),exist=existe) md = ucase(mode) select case (trim(md)) case ('R') if(.not.existe)then iret = -80 write(6,'(A,1x,A,1x,A)')'BAM error =>',trim(myname_),& 'Model file not found : '//trim(BFile%fdir) if(present(istat))istat=iret return endif !Get next available logical unit BFile%udir = BAM_GetAvailUnit( ) open(unit = BFile%udir, & file = trim(BFile%fdir), & status = 'old', & action = 'read', & form = 'formatted', & iostat = iret & ) case ('W') if(existe)then write(6,'(A,1x,A,1x,A)')'BAM error =>',trim(myname_),& 'Model File Already Exists : '//trim(BFile%fdir) write(6,'(A)')'Overwriting existing file!' endif !Get next available logical unit BFile%udir = BAM_GetAvailUnit( ) open(unit = BFile%udir, & file = trim(BFile%fdir), & status = 'new', & action = 'write', & form = 'formatted', & iostat = iret & ) end select if (iret.ne.0)then write(6,'(A,1x,A,1x,A,1x,I3)')'BAM error =>',trim(myname_),& 'Error to open model file: '//trim(BFile%fdir),iret if(present(istat))istat=iret return endif endsubroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: ReadHead_ - routine that read informations from dir file and ! initialize all BAM structure used to read and write BAM ! files. ! ! ! !DESCRIPTION: Esta rotina lê as informacões contidas no arquivo descritor do ! modelo BAM (arquivo DIR) e então inicializa a estrutura de dados ! (BAMFile) usada neste módulo para ler e escrever os arquivos do ! BAM. ! ! ! !INTERFACE: ! subroutine ReadHead_(BFile, istat ) USE InputParameters, ONLY: InitParameters, & Imax, Jmax, kmax, & mnwv2, Mend, & flon, flat implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(inout) :: BFile ! ! !OUTPUT PARAMETERS: ! integer, optional, intent(out) :: istat ! ! !SEE ALSO: ! ! setsig( ) - calcula niveis sigma ! InitParameters( ) - Inicializa algumas informacoes do modelo BAM ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = 'ReadHead_( ... )' integer :: k integer :: iret integer :: ilev, isum #ifdef DEBUG WRITE(stdout,'( 2A)')'Hello from ', trim(myname_) #endif rewind(BFile%udir) read (BFile%udir,'(A20)') BFile%head%ittl read (BFile%udir,'(A4,1X,A4,1X,A5,1X,11I5,1X,A4)') & BFile%head%nexp, BFile%head%sdain, BFile%head%trunc, & BFile%head%mMax, BFile%head%kmax, BFile%head%kmax, & BFile%head%fhr, BFile%head%fdy, BFile%head%fmo, BFile%head%fyr, & BFile%head%ihr, BFile%head%imo, BFile%head%idy, BFile%head%iyr, & BFile%head%dtin read (BFile%udir,'(2A41)') BFile%head%jttl, BFile%head%specal allocate(BFile%head%delSig(BFile%head%kmax)) !--------------------------------------------------------------------------------------! ! ! read (BFile%udir,'(5E16.8)') (BFile%head%delSig(k),k=1,BFile%head%kmax) ilev = 5 isum = 0 do while(isum .le. BFile%head%kmax) ilev = min(ilev, (BFile%head%kmax-isum)) READ (BFile%udir,*) (BFile%head%delSig(k+isum),k=1,ilev) isum = isum + 5 enddo !--------------------------------------------------------------------------------------! allocate(BFile%head%SigMid(BFile%head%kmax)) allocate(BFile%head%SigInt(BFile%head%kmax+1)) call setsig(& BFile%head%SigInt, & ! sigma value at each interface. BFile%head%SigMid, & ! sigma value at midpoint of each layer BFile%head%DelSig & ! sigma spacing for each layer. ) allocate(BFile%root) BFile%flds => BFile%root BFile%fcount = 0 do read (BFile%udir,'(A40,2X,A4,2X,I8,3X,I4,4X,I3)',& END=35,ERR=34,iostat=iret) & BFile%flds%Name, & BFile%flds%ProDia, & BFile%flds%nharm, & BFile%flds%nlevs, & BFile%flds%fldunit allocate(BFile%flds%next) BFile%flds => BFile%flds%next BFile%fcount = BFile%fcount + 1 enddo 34 write(*,'(A)') '!!! wrong header file '//trim(BFile%fdir),iret if(present(istat))then istat = iret return endif 35 continue ! ! Init Grid and Spectral parameters ! CALL InitParameters (BFile%head%mMax-1) BFile%head%IMax = Imax BFile%head%JMax = Jmax !KMax was read from Header BFile%head%mnwv2 = mnwv2 ! ! Lat/Lon informations ! allocate(BFile%head%rlat(JMax)) allocate(BFile%head%clat(JMax)) allocate(BFile%head%slat(JMax)) BFile%head%rlat ( JMax:1:-1 ) = flat( 1:JMax ) BFile%head%clat ( JMax:1:-1 ) = cos( flat( 1:JMax ) / rd ) BFile%head%slat ( JMax:1:-1 ) = sin( flat( 1:JMax ) / rd ) allocate(BFile%head%rlon(IMax)) allocate(BFile%head%clon(IMax)) allocate(BFile%head%slon(IMax)) BFile%head%rlon ( 1:IMax ) = flon( 1:IMax ) BFile%head%clon ( 1:IMax ) = cos( flon( 1:IMax ) / rd ) BFile%head%slon ( 1:IMax ) = sin( flon( 1:IMax ) / rd ) return 40 write (*, '(A)') & ' Unexpected End of File in Input File Directory.' stop 4100 end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: BAM_Close_ - routine that close all BAM files opened and reset all ! informations in BAMFile structure. ! ! ! !DESCRIPTION: Esta rotina fecha todos os arquivos do BAM (ANL, FCT, DIR) que ! estejam abertos e também reinicia todas as informacões contidas ! na estrutura de dados BAMFile. ! ! ! !INTERFACE: ! subroutine BAM_Close(BFile, istat) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(inout) :: BFile ! ! !OUTPUT PARAMETERS: ! integer, optional, intent( out) :: istat ! !SEE ALSO: ! ! ResetHead_( ) reset all information from BAMFile structure ! ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: BAM_Close( ... )' type(BAM_fld), pointer :: tmp => null() integer :: iret logical :: isopen if(present(istat)) istat = 0 ! ! close ANL file if is opened ! inquire(BFile%uanl, opened=isopen) if(isopen) then close(BFile%uanl, STATUS='KEEP', iostat=iret) if(iret.ne.0)then write(*,'(3(1x,A))')trim(myname_),': ERROR to close file',trim(BFile%fanl) if(present(istat)) istat = iret endif BFile%uanl = -1 BFile%fanl = '' endif ! ! close FCT file if is opened ! inquire(BFile%ufct, opened=isopen) if(isopen) then close(BFile%ufct, STATUS='KEEP', iostat=iret) if(iret.ne.0)then write(*,'(3(1x,A))')trim(myname_),': ERROR to close file',trim(BFile%ffct) if(present(istat)) istat = iret endif BFile%ufct = -1 BFile%ffct = '' endif ! ! close DIR file if is opened ! inquire(BFile%udir, opened=isopen) if(isopen) then close(BFile%udir, STATUS='KEEP', iostat=iret) if(iret.ne.0)then write(*,'(3(1x,A))')trim(myname_),': ERROR to close file',trim(BFile%fdir) if(present(istat)) istat = iret endif BFile%udir = -1 BFile%fdir = '' ! ! reset all header data ! call ResetHead_(BFile) ! ! reset vartable ! BFile%fcount = -1 tmp => BFile%root%next do deallocate(BFile%root) if(.not.associated(tmp)) exit BFile%root => tmp tmp => tmp%next enddo endif return end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: ResetHead_ - routine that reset all informations in BAMFile ! structure. ! ! ! !DESCRIPTION: Esta rotina reinicia todas as informacões contidas ! na estrutura de dados BAMFile. ! ! ! !INTERFACE: ! subroutine ResetHead_(BFile) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(inout) :: BFile ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: ResetHead_()' BFile%head%ittl = '' BFile%head%jttl = '' BFile%head%sdain = '' BFile%head%dtin = '' BFile%head%trunc = '' BFile%head%nexp = -1 BFile%head%mMax = -1 BFile%head%mnwv2 = -1 BFile%head%imax = -1 BFile%head%jmax = -1 BFile%head%kmax = -1 BFile%head%ihr = -1 BFile%head%idy = -1 BFile%head%imo = -1 BFile%head%iyr = -1 BFile%head%fhr = -1 BFile%head%fdy = -1 BFile%head%fmo = -1 BFile%head%fyr = -1 if(allocated(BFile%head%delsig))& deallocate(BFile%head%delsig) if(allocated(BFile%head%SigInt))& deallocate(BFile%head%SigInt) if(allocated(BFile%head%SigMid))& deallocate(BFile%head%SigMid) if(allocated(BFile%head%rlon))& deallocate(BFile%head%rlon) if(allocated(BFile%head%clon))& deallocate(BFile%head%clon) if(allocated(BFile%head%slon))& deallocate(BFile%head%slon) if(allocated(BFile%head%rlat))& deallocate(BFile%head%rlat) if(allocated(BFile%head%clat))& deallocate(BFile%head%clat) if(allocated(BFile%head%slat))& deallocate(BFile%head%slat) return end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: BAM_GetOneDim - return information about one dimension of BAM file. ! ! ! ! !DESCRIPTION: Rotina que retorma informacão sobre um das dimensões do arquivo ! do modelo BAM. Podem ser retornadas informacões sobre: ! ! 1. IMax : Número de pontos na direcão I (longitude) ! 2. JMax : Número de pontos na direcão J (latitude) ! 3. KMax : Número de pontos na direcão K (níveis verticais) ! 4. Mend : comprimento de onda (spectral) ! ! !INTERFACE: ! function BAM_GetOneDim(BFile, DName) result(dim) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(in ) :: BFile !BAM dimension name character(len=*), intent(in ) :: DName ! ! Can be: ! 1. imax - points in i direction (longitude) ! 2. jmax - points in j direction (latitude) ! 3. kmax - points in k direction (levels) ! 4. mend - wave number (spectral) ! ! ! !OUTPUT PARAMETERS: ! integer, intent( out) :: dim ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: BAM_GetOneDim( ... )' character(len=4) :: DimName DimName = Trim(Adjustl(lcase(DName))) select case (DimName) case ('imax') dim = BFile%head%IMax case ('jmax') dim = BFile%head%JMax case ('kmax') dim = BFile%head%KMax case ('mend') dim = BFile%head%mMax - 1 case default write(*,'(4A)')trim(myname_),': wrong dimension <',trim(DimName),'>' write(*,'( A)')'try: imax, jmax, kmax, mend' dim = -1 end select end function ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: BAM_GetTimeInfo - routine to return some information about the time ! of the BAM file ! ! ! !DESCRIPTION: Esta rotina retorna informacões sobre a data dos arquivos do ! modelo BAM. Podem ser retornadas as seguintes informacões: ! ! 1. ihr: Hora da condicão inicial utilizada para a simulacão ! 2. iyr: Ano da condicão inicial utilizada para a simulacão ! 3. idy: dia da condicão inicial utilizada para a simulacão ! 4. imo: mês da condicão inicial utilizada para a simulacão ! 5. fhr: hora da previsão da simulacão ! 6. fyr: ano da previsão da simulacão ! 7. fdy: dia da previsão da simulacão ! 8. fmo: mês da previsão da simulacão ! ! !INTERFACE: ! function BAM_GetTimeInfo(BFile, DName) result(dt) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(in ) :: BFile ! BAM time request character(len=*), intent(in ) :: DName ! ! Can be: ! 1. ihr: request hour of initial condition ! 2. iyr: request year of initial condition ! 3. idy: request day of initial condition ! 4. imo: request month of initial condition ! 5. fhr: request hour of forecast ! 6. fyr: request year of forecast ! 7. fdy: request day of forecast ! 8. fmo: request month of forecast ! ! !OUTPUT PARAMETERS: ! ! time of simulation integer, intent( out) :: dt ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: BAM_GetTimeInfo( ... )' character(len=4) :: DimName DimName = Trim(Adjustl(lcase(DName))) select case (DimName) case ('iyr') dt = BFile%head%iyr case ('imo') dt = BFile%head%imo case ('idy') dt = BFile%head%idy case ('ihr') dt = BFile%head%ihr case ('fyr') dt = BFile%head%fyr case ('fmo') dt = BFile%head%fmo case ('fdy') dt = BFile%head%fdy case ('fhr') dt = BFile%head%fhr case default write(*,'(4A)')trim(myname_),': wrong dimension <',trim(DimName),'>' write(*,'( A)')'try:' write(*,'( A)')' * ihr, idy, imo, iyr: Initial Time' write(*,'( A)')' * fhr, fdy, fmo, fyr: Forecast Time' write(*,'( A)')'' dt = -1 end select end function ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: BAM_GetDims - routine to return informations about all BAM file ! dimensions. ! ! ! !DESCRIPTION: Esta rotina retorna informacões sobre todas as dimensões do ! modelo BAM. São retornadas as seguintes informacões: ! ! 1. IMax : Número de pontos na direcão I (longitude) ! 2. JMax : Número de pontos na direcão J (latitude) ! 3. KMax : Número de pontos na direcão K (níveis verticais) ! 4. Mend : comprimento de onda (spectral) ! ! !INTERFACE: ! subroutine BAM_GetDims(BFile, Imax, Jmax, Kmax, Mend, istat) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(in ) :: BFile ! 1. imax - points in i direction (longitude) integer, intent( out) :: IMax ! 2. jmax - points in j direction (latitude) integer, intent( out) :: JMax ! 3. kmax - points in k direction (levels) integer, intent( out) :: KMax ! 4. mend - wave number (spectral) integer, intent( out) :: Mend ! ! !OUTPUT PARAMETERS: ! integer, optional, intent( out) :: istat ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: BAM_GetDims( ... )' IMax = BFile%head%IMax JMax = BFile%head%JMax KMax = BFile%head%KMax Mend = BFile%head%mMax - 1 end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IFUNCTION: BAM_GetNLevels - return how many vertical levels has one ! give variable ! ! ! !DESCRIPTION: Esta funcão retorna o número de níveis verticais que uma dada ! variável possui. ! ! ! ! !INTERFACE: ! function BAM_GetNlevels(BFile,VName,istat) result(nlevs) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(in ) :: BFile ! Name of a BAM variable character(len=*), intent(in ) :: VName ! ! !OUTPUT PARAMETERS: ! integer, optional, intent( out) :: istat ! ! !RETURN VALUE: ! integer :: NLevs ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: BAM_GetNLevels( ... )' type(BAM_fld), pointer :: fld integer :: f character(len=strlen) :: InqName character(len=strlen) :: FLDName if(present(istat)) istat = 0 InqName = trim(adjustl(lcase(VName))) NLevs = -1 fld => BFile%root do f=1,BFile%fcount FLDName = trim(adjustl(lcase(fld%name))) if(trim(InqName) .eq. trim(FLDName))then NLevs = fld%nlevs if(present(istat)) istat = 0 return endif fld => fld%next enddo if(NLevs .eq. -1 )then write(*,'(4A)')trim(myname_),': variable not found ! <',trim(InqName),trim(FLDName) if(present(istat)) istat = -1 endif return end function ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: BAM_GetWCoord - routine to return informations world coordinates ! of BAM model file ! ! ! !DESCRIPTION: Esta rotina retorna um vetor contendo o valor de uma determinada ! informacão geográfica do modelo BAM. Podem ser retornadas as ! seguintes informacões: ! ! 1. rlon : longitude real ! 2. slon : seno da longitude real ! 3. clon : cosseno da longitude real ! 4. rlat : latitude real ! 5. slat : seno da latitude real ! 6. clat : cosseno da latitude real ! ! !INTERFACE: ! subroutine BAM_GetWCoord(BFile, what, coord, istat) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(in ) :: BFile ! Name of inquired Word Coordinate character(len=*), intent(in ) :: what ! ! Can be: ! 1. rlon : real longitude ! 2. slon : sine of real longitude ! 3. clon : cosine of real longitude ! 4. rlat : real latitude ! 5. slat : sine of real latitude ! 6. clat : cosine of real latitude ! ! ! !OUTPUT PARAMETERS: ! real(r4), intent(inout) :: coord(:) integer, optional, intent( out) :: istat ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: BAM_GetWCoord( ... )' integer :: lenIn integer :: lenOu select case (trim(what)) case('rlon') ! real longitude !check consistensy lenIn = size(coord) lenOu = BFile%head%IMax if (lenIn.ne.lenOu) then write (stdout,'(2(1x,A))')trim(myname_),':ERROR, wrong size of coordinate array:' write (stdout,'(I4,1x,A,1x,I4)')lenIn,' .ne. ',lenOu return endif coord = BFile%head%rlon case('slon') ! sine of longitude !check consistensy lenIn = size(coord) lenOu = BFile%head%IMax if (lenIn.ne.lenOu) then write (stdout,'(2(1x,A))')trim(myname_),':ERROR, wrong size of coordinate array:' write (stdout,'(I4,1x,A,1x,I4)')lenIn,' .ne. ',lenOu return endif coord = BFile%head%slon case('clon') !cosine of longitude !check consistensy lenIn = size(coord) lenOu = BFile%head%IMax if (lenIn.ne.lenOu) then write (stdout,'(2(1x,A))')trim(myname_),':ERROR, wrong size of coordinate array:' write (stdout,'(I4,1x,A,1x,I4)')lenIn,' .ne. ',lenOu return endif coord = BFile%head%clon case('rlat') ! real latitude !check consistensy lenIn = size(coord) lenOu = BFile%head%JMax if (lenIn.ne.lenOu) then write (stdout,'(2(1x,A))')trim(myname_),':ERROR, wrong size of coordinate array:' write (stdout,'(I4,1x,A,1x,I4)')lenIn,' .ne. ',lenOu return endif coord = BFile%head%rlat case('slat') ! sine of latitude !check consistensy lenIn = size(coord) lenOu = BFile%head%JMax if (lenIn.ne.lenOu) then write (stdout,'(2(1x,A))')trim(myname_),':ERROR, wrong size of coordinate array:' write (stdout,'(I4,1x,A,1x,I4)')lenIn,' .ne. ',lenOu return endif coord = BFile%head%slat case('clat') ! cosine of latitude !check consistensy lenIn = size(coord) lenOu = BFile%head%JMax if (lenIn.ne.lenOu) then write (stdout,'(2(1x,A))')trim(myname_),':ERROR, wrong size of coordinate array:' write (stdout,'(I4,1x,A,1x,I4)')lenIn,' .ne. ',lenOu return endif coord = BFile%head%clat case default write(stdout,'2(1x,A)')trim(myname_),': ERROR' write(stdout,'2(1x,A)')'Wrong coordinate inquired :',trim(what) write(stdout,'2(1x,A)')'validy coordinates:' write(stdout,'2(1x,A)')' ' write(stdout,'2(1x,A)')'rlon : real longitude' write(stdout,'2(1x,A)')'clon : cosine of real longitude' write(stdout,'2(1x,A)')'slon : sine of real longitude' write(stdout,'2(1x,A)')' ' write(stdout,'2(1x,A)')'rlat : real latitude' write(stdout,'2(1x,A)')'clat : cosine of real latitude' write(stdout,'2(1x,A)')'slat : sine of real latitude' if(present(istat))istat = -1 return end select endsubroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: BAM_GetVerticalCoord - return informations vertical coordinates ! of BAM model. ! ! ! !DESCRIPTION: Esta rotina retorna um vetor contendo informacões sobre a ! coordenada vertical do modelo BAM. ! Podem ser retornadas as seguintes informacões: ! 1. Ak : ! 2. Bk : ! 3. Ck : ! 4. SI : ! 5. SL : ! 6. DL : ! ! ! !INTERFACE: ! subroutine BAM_GetVerticalCoord(BFile, what, vcoord, istat) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(in ) :: BFile ! Name of inquired Vertical Coordinate parameter character(len=*), intent(in ) :: what ! ! !OUTPUT PARAMETERS: ! real(r8), intent(inout) :: vcoord(:) integer, optional, intent( out) :: istat ! !REMARKS: ! ! Pressure is defined as: ! \begin{equation} ! p_{(i,j,k)} = A_{k}P_{0}+B_{k}P_{s}(i,j) ! \end{equation} ! ! where $p$ is the pressure at a given level and latitude, longitude grid point. ! The coefficients $A$, $B$ and $P_{0}$ are constants. $P_{s}$ is the model's current ! surface pressure. $P_{0}$ is set in the model code. The input model initial ! conditions dataset sets $A$ and $B$ through the variables hyam, hyai, hybm, and hybi. ! The subscript "i" refers to interface levels, and "m" refers to the mid-point levels. ! "hyam" then refers to Hybrid level "A" coefficient on the interfaces. ! ! More details on the theoretical nature of the vertical coordinate system can ! be found in Collins et al. [2004]. ! ! Collins, W. D., P. J. Rasch, and Others, Description of the NCAR Community ! Atmosphere Model (CAM 3.0), Technical Report NCAR/TN-464+STR, National Center ! for Atmospheric Research, Boulder, Colorado, 210 pp., 2004. ! ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: BAM_GetWCoord( ... )' character(len=2) :: vcn integer :: i if(present(istat)) istat = 0 vcn = ucase(trim(what)) select case (trim(vcn)) case ( 'AK' ) vcoord = -9.99 case ( 'BK' ) vcoord = BFile%head%SigInt case ( 'CK' ) vcoord = -9.99 case ( 'SI' ) vcoord = BFile%head%SigInt case ( 'SL' ) vcoord = BFile%head%SigMid case ( 'DL' ) vcoord = BFile%head%DelSig case default write (stdout,'(3(1x,A))')trim(myname_),': unknown requested parameter,:',trim(vcn) if(present(istat))istat = -1 end select return end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: BAM_GetSigValues - return vertical sigma parameters ! ! ! !DESCRIPTION: Esta rotina retorna os valores dos seguintes parametros da ! coordenada vertical sigma: ! ! 1. DelSig : diferenca entre os niveis sigma ! 2. SigInt : interface entre os niveis sigma ! 3. SigMid : ponto médio entre os níveis sigma ! ! !INTERFACE: ! subroutine BAM_GetSigValues(BFile, DelSig, SigInt, SigMid, istat) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(in ) :: BFile ! ! !OUTPUT PARAMETERS: ! real(r8), intent(inout) :: DelSig(:) real(r8), intent(inout) :: SigInt(:) real(r8), intent(inout) :: SigMid(:) integer, optional, intent( out) :: istat ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: BAM_GetSigmaValues( ... )' if(present(istat)) istat = 0 DelSig = BFile%head%DelSig SigInt = BFile%head%SigInt SigMid = BFile%head%SigMid end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: ReadFLDS_ - populate BAMFile structure < BFile%flds > ! ! ! !DESCRIPTION: Esta rotina não retorna nenhuma informacão, ao invés disto ela ! é utilizada para ler todos os campos previstos presentes em um ! arquivo de previsão do modelo BAM. Todos os campos são lidos e ! guardados na variável flds da estrutura de dados BAMFile, para ! depois ser acessada. ! ! ! !INTERFACE: ! subroutine ReadFLDS_(BFile, istat) implicit none ! ! !INPUT PARAMETERS: ! ! BAM file structure type(BAMFile), intent(inout) :: BFile ! ! !OUTPUT PARAMETERS: ! integer, optional, intent( out) :: istat ! !TO DO: ! ! criar métodos para acessar os campos armazenados na estrutura BAMFile que ! sejam transparentes ao usuário, porém não podem estar em conflito com os já ! criados para a leitura sequencial e individual de cada campo, como as ! rotinas: SGetFLD_1D, SGetFLD_2D, DGetFLD_1D, DGetFLD_2D. ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: ReadFLDS_( ... )' real (R8), dimension (:), allocatable :: bufx real (R4), dimension (:), allocatable :: bufs real (R8), dimension (:,:), allocatable :: bufw real (R4), dimension (:,:), allocatable :: bufr integer (I4) :: ifday real (R4) :: tod integer (I4) :: idate(4) integer (I4) :: idatec(4) integer :: fld integer :: lev integer :: iret integer :: IMax integer :: JMax integer :: KMax integer :: Mend integer :: mnwv2 ! ! geting some paramters ! call BAM_GetDims(BFile, IMax, JMax, KMax, Mend) MnWv2 = (Mend+1)*(Mend+2) ! ! Init Spectral parameters ! call InitRecomposition(Mend, IMax, JMax) ! ! back to begin of file ! rewind(BFile%ufct) ! ! read data information ! read (BFile%ufct) ifday,tod,idate,idatec ! ! Get root file information ! BFile%flds => BFile%root ! ! BAM fct files contain spectral an grid point data. ! This data are stored in a sequential unformatted ! format, so we need to access (through) the whole file! ! do fld=1,BFile%fcount allocate(BFile%flds%grid(imax,jmax,BFile%flds%nlevs)) if (BFile%flds%nharm .EQ. mnwv2) then Allocate (bufx (mnwv2)) Allocate (bufs (mnwv2)) Allocate (bufw (imax,jmax)) DO lev=1,BFile%flds%nlevs read (BFile%ufct,IOSTAT=iret) bufs bufx(1:mnwv2) = real(bufs(1:mnwv2),R8) call RecompositionScalar(1, bufx, bufw) BFile%flds%grid(:,:,lev) = real(bufw,R4) ENDDO DeAllocate (bufx) DeAllocate (bufs) DeAllocate (bufw) else DO lev=1,BFile%flds%nlevs read (Bfile%ufct,IOSTAT=iret) BFile%flds%grid(:,:,lev) ENDDO endif BFile%flds => BFile%flds%next enddo ! ! reset spectral/grid parameters ! call ClsMemRecomposition ( ) end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IFUNCTION: FindFLD_ - find position of a forecasted field in the BAM file ! ! ! !DESCRIPTION: Esta funcão retorna a posicão de um determinado campo previsto ! pelo modelo BAM indicado pelo arquivo DIR e assim poder acessa-lo ! no arquivo FCT. ! ! ! !INTERFACE: ! function FindFLD_(BFile, wfld, wlev) result(idx) implicit none ! ! !INPUT PARAMETERS: ! type(BAMFile), intent(in ) :: BFile ! file information character (len=*), intent(in ) :: wfld ! what field name ? integer, intent(in ) :: wlev ! what field level ? ! ! !RETURN VALUE: ! integer :: idx ! Field position ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: FindFLD_( ... )' character(len=strlen) :: InqName character(len=strlen) :: FldName type(BAM_fld), pointer :: fld integer :: ilev integer :: ifld ! ! Get root file information ! fld => BFile%root ! ! BAM fct files contain spectral an grid point data. ! This data are stored in a sequential unformatted ! format, so we need to access (through) the whole file! ! InqName = Trim(adjustl(lcase(wfld))) idx = -1 ilev = 0 do ifld=1,BFile%fcount FldName = Trim(Adjustl(lcase(fld%name))) if ( trim(InqName) .eq. trim(FldName) )then if(wlev .gt. fld%nlevs)then write(stdout,*)trim(myname_),': error, wlev > nlevs :', wlev, fld%nlevs return endif idx = ifld return else ilev = ilev + fld%nlevs endif fld => fld%next enddo end function ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: SGetFLD_1D - return a single precision 1D array with a requested ! forecast BAM field. ! ! ! !DESCRIPTION: Esta rotina retorna um vetor 1D em precisão simples contendo o ! campo previsto pelo modelo BAM que foi requisitado. ! ! !INTERFACE: ! subroutine SGetFLD_1D(BFile, wfld, wlev, grd, istat) implicit none ! ! !INPUT PARAMETERS: ! type(BAMFile), intent(in ) :: BFile ! file information character (len=*), intent(in ) :: wfld ! what field name ? integer, intent(in ) :: wlev ! what field level ? ! ! !OUTPUT PARAMETERS: ! real(r4), intent(inout) :: grd(:) integer, optional, intent( out) :: istat ! ! !SEE ALSO: ! ! DGetFLD_1D( ) - return a double precision 1D BAM Field ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = ':: SGetFLD_1D( ... )' real(r8) :: TmpGrd(size(grd,1)) integer :: iret call DGetFLD_1D(BFile, wfld, wlev, TmpGrd, istat) if(present(istat))istat = iret grd = real(TmpGrd,r4) return end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: SGetFLD_2D - return a single precision 2D array with a requested ! forecast BAM field. ! ! ! !DESCRIPTION: Esta rotina retorna um vetor 2D em precisão simples contendo o ! campo previsto pelo modelo BAM que foi requisitado. ! ! !INTERFACE: ! subroutine SGetFLD_2D(BFile, wfld, wlev, grd, istat) implicit none ! ! !INPUT PARAMETERS: ! type(BAMFile), intent(in ) :: BFile ! file information character (len=*), intent(in ) :: wfld ! what field name ? integer, intent(in ) :: wlev ! what field level ? ! ! !OUTPUT PARAMETERS: ! real(r4), intent(inout) :: grd(:,:) integer, optional, intent( out) :: istat ! ! !SEE ALSO: ! ! DGetFLD_2D( ) - return a double precision 2D BAM Field ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = ':: SGetFLD_2D( ... )' real(r8) :: TmpGrd(size(grd,1),size(grd,2)) integer :: iret call DGetFLD_2D(BFile, wfld, wlev, TmpGrd, iret) if(present(istat))istat = iret grd = real(TmpGrd,r4) return end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: DGetFLD_2D - return a double precision 2D array with a requested ! forecast BAM field. ! ! ! !DESCRIPTION: Esta rotina retorna um vetor 2D em precisão dupla contendo o ! campo previsto pelo modelo BAM que foi requisitado. ! ! !INTERFACE: ! subroutine DGetFLD_2D(BFile, wfld, wlev, grd, istat) implicit none ! ! !INPUT PARAMETERS: ! type(BAMFile), intent(in ) :: BFile ! file information character (len=*), intent(in ) :: wfld ! what field name ? integer, intent(in ) :: wlev ! what field level ? ! ! !OUTPUT PARAMETERS: ! real(r8), intent(inout) :: grd(:,:) integer, optional, intent( out) :: istat ! ! !SEE ALSO: ! ! DGetFLD_1D( ) - return a double precision 1D BAM Field ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = ':: DGetFLD_2D( ... )' real(r8), allocatable :: fld (:) integer :: i, j, k integer :: IMax, JMax integer :: npts integer :: iret npts = size(grd) allocate(fld(npts)) call DGetFLD_1D(BFile, wfld, wlev, fld, iret) if(present(istat)) istat = iret IMax = size(grd,1) JMax = size(grd,2) k = 1 do j = 1,JMax do i = 1, IMax grd(i,j) = fld(k) k = k + 1 enddo enddo end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: SGetFLD_1D - return a double precision 1D array with a requested ! forecast BAM field. ! ! ! !DESCRIPTION: Esta rotina retorna um vetor 1D em precisão dupla contendo o ! campo previsto pelo modelo BAM que foi requisitado. ! ! !INTERFACE: ! subroutine DGetFLD_1D(BFile, wfld, wlev, grd, istat) implicit none ! ! !INPUT PARAMETERS: ! type(BAMFile), intent(in ) :: BFile ! file information character (len=*), intent(in ) :: wfld ! what field name ? integer, intent(in ) :: wlev ! what field level ? ! ! !OUTPUT PARAMETERS: ! real(r8), intent(inout) :: grd(:) integer, optional, intent( out) :: istat ! ! !SEE ALSO: ! ! BAM_GetDims( ) - return BAM field dimensions ! FindFLD_( ) - return BAM field position ! ReadField( ) - read a BAM field in double or sigle precision ! InitRecomposition( ) - initialize spectral2grid routines ! RecompositionScalar( ) - convert spectral2grid fields ! ClsMemRecomposition( ) - finalize spectral2grid routines ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = ':: DGetFLD_1D( ... )' integer :: ifld integer :: ilev integer :: iret type(BAM_fld), pointer :: fld real (R8), dimension (:), allocatable :: bufx real (R4), dimension (:), allocatable :: bufs real (R8), dimension (:,:), allocatable :: bufw real (R4), dimension (:,:), allocatable :: bufr integer (I4) :: ifday real (R4) :: tod integer (I4) :: idate(4) integer (I4) :: idatec(4) integer :: IMax integer :: JMax integer :: KMax integer :: Mend integer :: Mnwv2 integer :: i, j, k integer :: idx integer :: npts character(len=strlen) :: InqName character(len=strlen) :: FldName if(present(istat)) istat = 0 ! ! get BAM file dimensions ! call BAM_GetDims(BFile, imax, jmax, kmax, Mend) Mnwv2 = (Mend+1)*(Mend+2) ! ! Init Spectral parameters ! call InitRecomposition(Mend, IMax, JMax) ! ! Find field inside BAM file ! idx = FindFLD_(BFile, wfld, wlev) if (idx .lt. 0)then ! write(*,*)trim(myname_),' :: Field Not found ...' call perr(trim(myname_),'Field Not Found ...['//trim(BFile%ffct)//' ]') if(present(istat))istat = idx return endif ! ! back to begin of file ! rewind(BFile%ufct) ! ! read header time information ! read (BFile%ufct) ifday,tod,idate,idatec ! ! Get root file information ! fld => BFile%root ! ! BAM fct files contain spectral an grid point data. ! This data are stored in a sequential unformatted ! format, so we need to access (through) the whole file! ! ! ! skipping undesired fields ! if (idx .gt. 1)then do ifld=1,idx-1 do ilev=1,fld%nlevs call ReadField (BFile%ufct, iret) if (iret.ne.0)then if(present(istat)) istat = iret write(stdout,*)trim(myname_),': error to read file ::','['//trim(BFile%ffct)//' ], ',iret endif enddo fld => fld%next enddo do ilev=1,wlev-1 call ReadField (BFile%ufct, iret) if (iret.ne.0)then if(present(istat)) istat = iret write(stdout,*)trim(myname_),': error to read file ::','['//trim(BFile%ffct)//' ], ',iret endif enddo endif ! ! Get Field ! allocate(bufs(fld%nharm)) call ReadField (BFile%ufct, bufs, iret) if (iret.ne.0)then if(present(istat)) istat = iret write(stdout,*)trim(myname_),': error to read file ::','['//trim(BFile%ffct)//' ], ',iret endif npts = size(grd) if ( ( npts .eq. (IMax*JMax) ) .and. (fld%nharm .eq. mnwv2 )) then ! ! field is spectral but need return grid point ! allocate (bufx (mnwv2)) bufx(1:mnwv2) = real(bufs(1:mnwv2),R8) deallocate(bufs) allocate (bufw (imax,jmax)) call RecompositionScalar(1, bufx, bufw) k = 1 do j = 1, JMax do i = 1, IMax grd(k) = bufw(i,j) k = k + 1 enddo enddo deallocate(bufw) else grd = real(bufs,r8) endif ! ! reset spectral/grid parameters ! call ClsMemRecomposition ( ) return end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: SRead1D_ - read and return a 1D sigle precision BAM field. ! ! ! !DESCRIPTION: Esta rotina lê e retorna um campo modelo BAM em um vetor 1D em ! precisão simples ! ! !INTERFACE: ! subroutine SRead1D_(funit, fld, istat) implicit none ! ! !INPUT PARAMETERS: ! integer(i4), intent(in ) :: funit ! ! !OUTPUT PARAMETERS: ! real(r4), intent( out) :: fld(:) integer(i4), optional, intent( out) :: istat ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = ':: SRead1D_( ... )' integer :: iret if(present(istat)) istat = 0 read(unit = funit, iostat = iret) fld if (iret.ne.0)then write(stdout,*)trim(myname_),': error to read field, ',iret if(present(istat)) istat = iret endif end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: SRead2D_ - read and return a 2D sigle precision BAM field. ! ! ! !DESCRIPTION: Esta rotina lê e retorna um campo modelo BAM em um matriz 2D em ! precisão simples ! ! !INTERFACE: ! subroutine SRead2D_(funit, fld, istat) implicit none ! ! !INPUT PARAMETERS: ! integer(i4), intent(in ) :: funit ! ! !OUTPUT PARAMETERS: ! real(r4), intent( out) :: fld(:,:) integer(i4), optional, intent( out) :: istat ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = ':: SRead2D_( ... )' integer :: iret if(present(istat))istat=0 read(unit = funit, iostat = iret) fld if (iret.ne.0)then write(stdout,*)trim(myname_),': error to read field, ',iret if(present(istat)) istat = iret endif end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: SRead3D_ - read and return a 3D sigle precision BAM field. ! ! ! !DESCRIPTION: Esta rotina lê e retorna um campo modelo BAM em um vetor 3D em ! precisão simples ! ! !INTERFACE: ! subroutine SRead3D_(funit, fld,istat) implicit none ! ! !INPUT PARAMETERS: ! integer(i4), intent(in ) :: funit ! ! !OUTPUT PARAMETERS: ! real(r4), intent( out) :: fld(:,:,:) integer(i4), optional, intent( out) :: istat ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = ':: SRead3D_( ... )' integer :: iret if(present(istat))istat=0 read(unit = funit, iostat = iret) fld if (iret.ne.0)then write(stdout,*)trim(myname_),': error to read file, ',iret if(present(istat)) istat = iret endif end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: DRead1D_ - read and return a 1D double precision BAM field. ! ! ! !DESCRIPTION: Esta rotina lê e retorna um campo modelo BAM em um vetor 1D em ! precisão dupla. ! ! !INTERFACE: ! subroutine DRead1D_(funit, fld, istat) implicit none ! ! !INPUT PARAMETERS: ! integer(i4), intent(in ) :: funit ! ! !OUTPUT PARAMETERS: ! real(r8), intent( out) :: fld(:) integer(i4), optional, intent( out) :: istat ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = ':: SRead1D_( ... )' integer :: iret if(present(istat)) istat = 0 read(unit = funit, iostat = iret) fld if (iret.ne.0)then write(stdout,*)trim(myname_),': error to read file, ',iret if(present(istat)) istat = iret endif end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: DRead2D_ - read and return a 2D double precision BAM field. ! ! ! !DESCRIPTION: Esta rotina lê e retorna um campo modelo BAM em um matriz 2D em ! precisão dupla. ! ! !INTERFACE: ! subroutine DRead2D_(funit, fld, istat) implicit none ! ! !INPUT PARAMETERS: ! integer(i4), intent(in ) :: funit ! ! !OUTPUT PARAMETERS: ! real(r8), intent( out) :: fld(:,:) integer(i4), optional, intent( out) :: istat ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = ':: DRead2D_( ... )' integer :: iret if(present(istat))istat=0 read(unit = funit, iostat = iret) fld if (iret.ne.0)then write(stdout,*)trim(myname_),': error to read file, ',iret if(present(istat)) istat = iret endif end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: DRead3D_ - read and return a 3D double precision BAM field. ! ! ! !DESCRIPTION: Esta rotina lê e retorna um campo modelo BAM em um matriz 3D em ! precisão dupla. ! ! !INTERFACE: ! subroutine DRead3D_(funit, fld,istat) implicit none ! ! !INPUT PARAMETERS: ! integer(i4), intent(in ) :: funit ! ! !OUTPUT PARAMETERS: ! real(r8), intent( out) :: fld(:,:,:) integer(i4), optional, intent( out) :: istat ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = ':: DRead3D_( ... )' integer :: iret if(present(istat))istat=0 read(unit = funit, iostat = iret) fld if (iret.ne.0)then write(stdout,*)trim(myname_),': error to read file, ',iret if(present(istat)) istat = iret endif end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: SkipRead_ - skip a sequential read in a BAM field. ! ! ! !DESCRIPTION: Esta rotina pula a leitura sequencial de um campo modelo BAM. ! ! ! !INTERFACE: ! subroutine SkipRead_(funit, istat) implicit none ! ! !INPUT PARAMETERS: ! integer(i4), intent(in ) :: funit ! ! !OUTPUT PARAMETERS: ! integer(i4), optional, intent( out) :: istat ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = 'SkipRead_( ... )' integer :: iret if(present(istat))istat=0 read(unit = funit, iostat = iret) if (iret.ne.0)then write(stdout,*)trim(myname_),': error to skip read file, ',iret if(present(istat)) istat = iret endif end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !----------------------------------------------------------------------- !BOP ! ! !IROUTINE: BAM_WriteAnlHeader - write a Header information in a Initial ! condition BAM file ! ! ! !DESCRIPTION: Esta rotina escreve o cabecalho do arquivo de condicão inicial ! do modelo BAM. ! ! !INTERFACE: subroutine BAM_WriteAnlHeader(BAM, mydate, istat) implicit none ! ! !INPUT PARAMETERS: ! type(BAMFile), intent(in ) :: BAM ! BAM files data type integer, intent(in ) :: mydate(:) ! Anl date ! ! !OUTPUT PARAMETERS: ! integer, optional, intent( out) :: istat ! code error status ! !REVISION HISTORY: ! 03 Aug 2016 - J. G. de Mattos - Initial code ! !EOP !----------------------------------------------------------------------- !BOC character(len=100), parameter :: myname_=':: BAM_WriteAnlHeader( ... )' integer :: iret integer (i4) :: idate (4) integer (i4) :: idatec(4) integer (i4) :: ifday real (r4) :: tod integer (i4) :: KMax integer (i4) :: KMaxP real (r8), allocatable :: del(:) real (r8), allocatable :: si(:) real (r8), allocatable :: sl(:) integer :: k real :: sumdel ! Get forecast day, time of day, dates ifday = 0 tod = 0.0 ! ------------------- ! idate(1) - hour ! idate(2) - month ! idate(3) - day ! idate(4) - year idate(4) = mydate(1) idate(2) = mydate(2) idate(3) = mydate(3) idate(1) = mydate(4) idatec = idate ! ! Get sigma levels ! KMax = BAM_GetOneDim(BAM, 'KMax') KMaxP = KMax + 1 allocate( del( KMax) ) allocate( si (KMaxP) ) allocate( sl ( KMax) ) call BAM_GetSigValues (BAM, del, si, sl, iret) ! do k=1,kmaxp ! write (6,'(a,i2,1(a,f10.6))') & ! ' level = ', k, ' si = ', real(si(k),r4) ! enddo ! write (6,'(a)')' ' ! sumdel = 0.0 ! do k=1,kmax ! sumdel = sumdel + del(k) ! write (6,'(a,i2,2(a,f10.6))') & ! ' layer = ', k, ' sl = ', real(sl(k),r4), ' del = ', del(k) ! enddo ! write (6,'(/,a,i3,a,f12.8,/)') ' kmax = ', kmax, ' sum del = ', sumdel ! sl = sl(kmax:1:-1) ! si = si(kmaxp:1:-1) ! si(1) = 0.000001_r8 ! to avoid floating point exceptions Write (BAM%uanl, iostat = iret) ifday, tod, idate, idatec, real(si,r4), real(sl,r4) if(present(istat)) istat = iret deallocate(del) deallocate(si) deallocate(sl) end subroutine !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: WriteField_MPI - write fields of BAM files from a MPI Pe. ! ! ! !DESCRIPTION: Esta rotina escreve um campo do modelo BAM ! ! ! !INTERFACE: ! subroutine WriteField_MPI(OutUnit, field, OutPe, iCount, istat) implicit none ! ! !INPUT PARAMETERS: ! ! Output logical unit integer(i4), intent(in ) :: OutUnit ! Field to be writed real(r8), intent(in ) :: field(:) ! How many Pe's are working integer(i4), intent(in ) :: iCount ! What Pe will write integer(i4), intent(in ) :: OutPe ! ! !OUTPUT PARAMETERS: ! integer(i4), optional, intent( out) :: istat ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: WriteFields_MPI( ... )' real(r8), allocatable :: buff(:) integer :: sizebuff integer :: Pe integer :: iret if(present(istat)) istat = 0 sizebuff = size(field) allocate(buff(sizebuff)) do Pe = 0, iCount-1 if(Pe .eq. OutPe)then call WriteField_Serial(OutUnit, field, iret) if(iret .ne. 0)then write(stdout,*)trim(myname_),': error to write field, ',iret if(present(istat)) istat = iret return endif else call mpi_recv(buff, sizebuff, MPI_DOUBLE, Pe, MPITag, MPI_COMM_WORLD, status, iret) call WriteField_Serial(OutUnit, buff, iret) if(iret .ne. 0)then if(present(istat)) istat = iret return endif endif end do deallocate(buff) end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: WriteField_Serial_ - ! ! ! !DESCRIPTION: ! ! ! !INTERFACE: ! subroutine WriteField_Serial(OutUnit, Field, istat) implicit none ! ! !INPUT PARAMETERS: ! ! Output logical unit integer(i4), intent(in ) :: OutUnit ! Field to be writed real(r8), intent(in ) :: Field(:) ! ! !OUTPUT PARAMETERS: ! integer(i4), optional, intent( out) :: istat ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: WriteFields_Serial( ... )' real(r4), allocatable :: tmp(:) integer :: iret integer :: siz siz=size(Field) allocate(tmp(siz)) tmp = real(Field,r8) if(present(istat)) istat = 0 ! write( OutUnit, iostat = iret ) Field write( OutUnit, iostat = iret ) tmp if(iret .ne. 0)then write(*,'(1A)')trim(myname_),': ERROR to write BAM file' if(present(istat)) istat = iret return endif return end subroutine ! !EOC ! !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! ! !BOP ! ! !IROUTINE: BAM_SendField_ - ! ! ! !DESCRIPTION: ! ! ! !INTERFACE: ! subroutine BAM_SendField(MyPe, toPe, Field, istat) implicit none ! ! !INPUT PARAMETERS: ! ! Source Pe integer(i4), intent(in ) :: MyPe ! Target Pe integer(i4), intent(in ) :: toPe ! Field to be send real(r8), intent(in ) :: field(:) ! ! !OUTPUT PARAMETERS: ! integer(i4), optional, intent( out) :: istat ! ! !REVISION HISTORY: ! ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=100), parameter :: myname_=':: BAM_SendField( ... )' integer :: iret integer :: sizefield if(present(istat)) istat = 0 sizefield = size(field) call mpi_send(field, sizefield, MPI_DOUBLE, toPe, MPITag, MPI_COMM_WORLD, iret) if(iret .ne. 0)then write(*,'(2A,I5,1x,A,1x,I5)')trim(myname_),': ERROR to send field from',MyPe,'to',toPe if(present(istat)) istat = iret return endif end subroutine !----------------------------------------------------------------------- !BOP ! ! !IROUTINE: upper_case - convert lowercase letters to uppercase. ! ! !DESCRIPTION: ! ! !INTERFACE: function ucase(str) result(ustr) implicit none character(len=*), intent(in) :: str character(len=len(str)) :: ustr ! !REVISION HISTORY: ! 13Aug96 - J. Guo - (to do) !EOP !----------------------------------------------------------------------- integer i integer,parameter :: il2u=ichar('A')-ichar('a') ustr=str do i=1,len_trim(str) if(str(i:i).ge.'a'.and.str(i:i).le.'z') & ustr(i:i)=char(ichar(str(i:i))+il2u) end do end function ucase !----------------------------------------------------------------------- !BOP ! ! !IROUTINE: lower_case - convert uppercase letters to lowercase. ! ! !DESCRIPTION: ! ! !INTERFACE: function lcase(str) result(lstr) implicit none character(len=*), intent(in) :: str character(len=len(str)) :: lstr ! !REVISION HISTORY: ! 13Aug96 - J. Guo - (to do) !EOP !----------------------------------------------------------------------- integer i integer,parameter :: iu2l=ichar('a')-ichar('A') lstr=str do i=1,len_trim(str) if(str(i:i).ge.'A'.and.str(i:i).le.'Z') & lstr(i:i)=char(ichar(str(i:i))+iu2l) end do end function lcase subroutine perr1_(where, message) implicit none character(len=*), intent(in) :: where character(len=*), intent(in) :: message write(stderr,'(4A)')'Error at ',trim(where),' : ', trim(message) end subroutine !-----------------------------------------------------------------------------! ! Modeling and Development Division - DMD/CPTEC/INPE ! !-----------------------------------------------------------------------------! !BOP ! ! !FUNCTION: GetAvailUnit ! ! !DESCRIPTON: function to return next available logical unit ! ! ! ! ! !INTERFACE: ! function GetAvailUnit( exclude ) result( lu ) implicit none ! ! !INPUT PARAMETERS: ! ! Skip this logical unit integer, optional :: exclude(:) ! ! !RETURN VALUE: ! integer :: lu ! ! !REVISION HISTORY: ! 11 Oct 2016 - J. G. de Mattos - Initial Version ! ! !EOP !-----------------------------------------------------------------------------! !BOC ! character(len=*), parameter :: myname_ = ':: GetAvailUnit( ... )' integer, parameter :: MaxLogicalUnit = 254 integer :: iunit integer :: ios logical :: isopen integer :: i ! start open loop for lun search find_unit:do iunit = 10, MaxLogicalUnit if (present(exclude))then do i=1,size(exclude) if (iunit.eq.exclude(i)) cycle find_unit enddo endif inquire (Unit = iunit, opened = isopen, iostat = ios ) if (.not.isopen.and.ios.eq.0)then lu = iunit return endif end do find_unit end function GetAvailUnit subroutine setsig (si, sl, del) ! calculates the ! sigma value at each interface and the ! sigma value at midpoint of each layer given the ! sigma spacing for each layer. ! ! argument(dimensions) description ! ! del(kmax) input : sigma spacing for each layer. ! si(kmaxp) output : sigma value at each interface. ! sl(kmax) output : sigma value at midpoint of ! each layer : (k=287/1005) ! ! 1 ! +- + --- ! | k+1 k+1 | k ! | si(l) - si(l+1) | ! sl(l) = | --------------------- | ! | (k+1) (si(l)-si(l+1)) | ! +- -+ ! ! ci(kmaxp) local : ci(l)=1.0-si(l). implicit none real (kind=r8), intent (in ) :: del(:) real (kind=r8), intent (inout) :: sl(:) real (kind=r8), intent (inout) :: si(:) integer (kind=i4) :: kmax integer (kind=i4) :: kmaxp integer (kind=i4) :: kmaxm, k real (kind=r8) :: sumdel, rk, rk1, sirk, sirk1, dif real (kind=r8), allocatable :: ci(:) kmax = size(del) kmaxp = kmax + 1 allocate(ci(kmaxp)) ci(1) = 0.0 sumdel = 0.0 do k = 1, kmax sumdel = sumdel+del(k) ci(k+1) = ci(k)+del(k) enddo ci(kmaxp) = 1.0 rk = 287.05/1005.0 rk1 = rk+1.0 do k=1,kmaxp si( k ) = 1.0 - ci( k ) enddo kmaxm = kmax-1 do k=1,kmax ! ! dif=si(k)**rk1-si(k+1)**rk1 ! sirk=exp(rk1*log(si(k))) if (k .le. kmaxm) then sirk1=exp(rk1*log(si(k+1))) else sirk1=0.0 endif dif=sirk-sirk1 dif=dif/(rk1*(si(k)-si(k+1))) ! ! sl(k)=dif**(one/rk) ! sl(k)=exp(log(dif)/rk) enddo ! write (6,'(/,a,/)') ' from setsig: ' ! do k=1,kmaxp ! write (6,'(a,i2,2(a,f10.6))') & ! ' level = ', k, ' ci = ', ci(k), ' si = ', si(k) ! enddo ! write (6,'(a)')' ' ! do k=1,kmax ! write (6,'(a,i2,2(a,f10.6))') & ! ' layer = ', k, ' sl = ', sl(k), ' del = ', del(k) ! enddo write (6,'(/,a,i3,a,f12.8,/)') ' kmax = ', kmax, ' sum del = ', sumdel deallocate(ci) end subroutine setsig !EOC end module sigio_bammod