init_mod.F90

Go to the documentation of this file.

module init_mod

  implicit none

  public

  integer, parameter :: maxvars = 60
  character(len=10)  :: maskvar = 'h'
  type :: vardefs
     character(len= 20)   :: var_name
     character(len=120)   :: long_name
     character(len= 20)   :: units
     character(len= 20)   :: var_remapmethod
     integer              :: var_dimen
     character(len=  4)   :: var_grid
     character(len= 20)   :: var_pair
     character(len=  4)   :: var_pair_grid
  end type vardefs

  type(vardefs) :: outvars(maxvars)

  character(len=10)  :: ftype
  character(len=10)  :: fsrc
  character(len=10)  :: fdst
  character(len=120) :: wgtsdir
  character(len=120) :: griddir
  character(len=20)  :: input_file

  integer :: nxt
  integer :: nyt
  integer :: nlevs

  integer :: nxr
  integer :: nyr

  integer :: logunit
  logical :: debug
  logical :: do_ocnprep

contains
  subroutine readnml(fname,errmsg,rc)

    character(len=*), intent(in)  :: fname
    character(len=*), intent(out) :: errmsg
    integer,          intent(out) :: rc

    ! local variable
    logical :: fexist
    integer :: ierr, iounit
    integer :: srcdims(2), dstdims(2)
    !----------------------------------------------------------------------------

    namelist /ocniceprep_nml/ ftype, wgtsdir, griddir, srcdims, dstdims, debug

    srcdims = 0; dstdims = 0
    errmsg='' ! for successful return
    rc = 0    ! for successful retun

    inquire(file=trim(fname), exist=fexist)
    if (.not. fexist) then
       write (errmsg, '(a)') 'FATAL ERROR: input file '//trim(fname)//' does not exist.'
       rc = 1
       return
    else
       ! Open and read namelist file.
       open (action='read', file=trim(fname), iostat=ierr, newunit=iounit)
       read (nml=ocniceprep_nml, iostat=ierr, unit=iounit)
       if (ierr /= 0) then
          rc = 1
          write (errmsg, '(a)') 'FATAL ERROR: invalid namelist format.'
          return
       end if
       close (iounit)
    end if

    ! append slash to wgtsdir and griddir
    wgtsdir = trim(wgtsdir)//'/'
    griddir = trim(griddir)//'/'

    ! check that model is either ocean or ice
    if (trim(ftype) /= 'ocean' .and. trim(ftype) /= 'ice') then
       rc = 1
       write (errmsg, '(a)') 'FATAL ERROR: ftype must be ocean or ice'
       return
    end if

    ! set grid dimensions and names
    nxt = srcdims(1); nyt = srcdims(2)
    nxr = dstdims(1); nyr = dstdims(2)
    fsrc = '' ; fdst = ''
    if (nxt == 1440 .and. nyt == 1080) fsrc = 'mx025'    ! 1/4deg tripole
    if (len_trim(fsrc) == 0) then
       rc = 1
       write(errmsg,'(a)')'FATAL ERROR: source grid dimensions invalid'
       return
    end if

    if (nxr == 720  .and. nyr == 576) fdst = 'mx050'     ! 1/2deg tripole
    if (nxr == 360  .and. nyr == 320) fdst = 'mx100'     ! 1deg tripole
    if (nxr == 72   .and. nyr == 35)  fdst = 'mx500'     ! 5deg tripole
    if (len_trim(fdst) == 0) then
       rc = 1
       write(errmsg,'(a)')'FATAL ERROR: destination grid dimensions invalid'
       return
    end if

    if (trim(fdst) == 'mx500') then
       rc = 1
       write(errmsg,'(a)')'FATAL ERROR: 5deg destination grid is not supported'
       return
    end if

    ! initialize the source file types
    if (trim(ftype) == 'ocean') then
       do_ocnprep = .true.
    else
       do_ocnprep = .false.
    end if

    input_file = trim(ftype)//'.nc'
    inquire (file=trim(input_file), exist=fexist)
    if (.not. fexist) then
       write (errmsg, '(a)') 'FATAL ERROR: input file '//trim(input_file)//' does not exist.'
       rc=1
       return
    end if

    ! log file
    open(newunit=logunit, file=trim(ftype)//'.prep.log',form='formatted')
    if (debug) write(logunit, '(a)')'input file: '//trim(input_file)

    ! all checks pass, continue
    write(errmsg,'(a)') 'Namelist successfully read, continue'
    rc = 0

  end subroutine readnml

  subroutine readcsv(fname,errmsg,rc,nvalid)

    character(len=*), intent(in)  :: fname
    character(len=*), intent(out) :: errmsg
    integer, intent(out)          :: rc
    integer, intent(out)          :: nvalid

    ! local variables
    character(len=100) :: chead
    character(len= 20) :: c1,c3,c4,c5,c6
    integer :: i2, idx1,idx2
    integer :: nn,n,ierr,iounit
    !----------------------------------------------------------------------------

    errmsg='' ! for successful return
    rc = 0    ! for successful retun

    open(newunit=iounit, file=trim(fname), status='old', iostat=ierr)
    if (ierr /= 0) then
       rc = 1
       write (errmsg, '(a)') 'FATAL ERROR: input file '//trim(fname)//' does not exist.'
       return
    end if

    read(iounit,*)chead
    nn=0
    do n = 1,maxvars
       read(iounit,*,iostat=ierr)c1,i2,c3,c4,c5,c6
       if (ierr .ne. 0) exit
       if (len_trim(c1) > 0) then
          nn = nn+1
          outvars(nn)%var_name = trim(c1)
          outvars(nn)%var_dimen = i2
          outvars(nn)%var_grid = trim(c3)
          outvars(nn)%var_remapmethod = trim(c4)
          outvars(nn)%var_pair = trim(c5)
          outvars(nn)%var_pair_grid = trim(c6)
       end if
    end do
    close(iounit)
    nvalid = nn

    ! check for u,v pairs, these should be listed in csv file in ordered pairs
    idx1 = 0; idx2 = 0
    do n = 1,nvalid
       if (len_trim(outvars(n)%var_pair) > 0 .and. idx1 .eq. 0) then
          idx1 = n
          idx2 = n+1
       end if
    end do

    if (trim(outvars(idx1)%var_pair) /= trim(outvars(idx2)%var_name)) then
       rc = 1
       write(errmsg,'(a)')'FATAL ERROR: vector pair for '//trim(outvars(idx1)%var_name) &
            //' is not set correctly'
       return
    end if
    if (trim(outvars(idx2)%var_pair) /= trim(outvars(idx1)%var_name)) then
       rc = 1
       write(errmsg,'(a)')'FATAL ERROR: vector pair for '//trim(outvars(idx2)%var_name) &
            //' is not set correctly'
       return
    end if

    ! check for u velocities on u-staggers and v-velocities on v-staggers
    if (outvars(idx1)%var_name(1:1) == 'u') then
       if ((outvars(idx1)%var_grid(1:2) /= 'Cu') .and. outvars(idx1)%var_grid(1:2) /= 'Bu') then
          rc = 1
          write(errmsg,'(a)')'FATAL ERROR: u-vector has wrong grid '
          return
       end if
    end if
    if (outvars(idx2)%var_name(1:1) == 'v') then
       if ((outvars(idx2)%var_grid(1:2) /= 'Cv') .and. outvars(idx2)%var_grid(1:2) /= 'Bu') then
          rc = 1
          write(errmsg,'(a)')'FATAL ERROR: v-vector has wrong grid '
          return
       end if
    end if

    ! all checks pass, continue
    write(errmsg,'(a)')'CSV successfully read, continue'
    rc = 0

  end subroutine readcsv
end module init_mod