checkinitvalues Subroutine

public subroutine checkinitvalues()

Uses

  • proc~~checkinitvalues~~UsesGraph proc~checkinitvalues checkinitvalues module~modglobal modglobal proc~checkinitvalues->module~modglobal module~modmpi modmpi proc~checkinitvalues->module~modmpi module~modsurfdata modsurfdata proc~checkinitvalues->module~modsurfdata mpi mpi module~modmpi->mpi

Arguments

None

Calls

proc~~checkinitvalues~~CallsGraph proc~checkinitvalues checkinitvalues mpi_bcast mpi_bcast proc~checkinitvalues->mpi_bcast mpi_finalize mpi_finalize proc~checkinitvalues->mpi_finalize

Called by

proc~~checkinitvalues~~CalledByGraph proc~checkinitvalues checkinitvalues program~dalesurban DALESURBAN program~dalesurban->proc~checkinitvalues

Source Code

   subroutine checkinitvalues
      !-----------------------------------------------------------------|
      !                                                                 |
      !      Thijs Heus   TU Delft  9/2/2006                            |
      !                                                                 |
      !     purpose.                                                    |
      !     --------                                                    |
      !                                                                 |
      !      checks whether crucial parameters are set correctly        |
      !                                                                 |
      !     interface.                                                  |
      !     ----------                                                  |
      !                                                                 |
      !     *checkinitvalues* is called from *program*.                 |
      !                                                                 |
      !-----------------------------------------------------------------|

      use modsurfdata, only : wtsurf, wqsurf, qts, ps
      use modglobal,   only : itot,ktot,jtot,ylen,xlen,ib,ie,dtmax,runtime, &
                              startfile,lwarmstart,lstratstart,lmoist, nsv, &
                              BCxm, BCxT, BCxq, BCxs, BCym, BCyT, BCyq, BCys, BCtopm, BCbotm, &
                              BCbotm_wfneutral, BCtopm_pressure, &
                              BCxm_periodic, BCxT_periodic, BCxq_periodic, &
                              BCxm_profile, BCxT_profile, BCxq_profile, &
                              BCxm_driver, BCxT_driver, BCxq_driver, BCxs_driver, &
                              BCym_periodic, BCym_profile, BCyT_periodic, BCyT_profile, &
                              BCyq_periodic, BCyq_profile, &
                              iinletgen,linoutflow,ltempeq,iwalltemp,iwallmom,&
                              ipoiss,POISS_FFT2D,POISS_FFT3D,POISS_CYC,&
                              lydump,lytdump,luoutflowr,lvoutflowr,&
                              lhdriver,lqdriver,lsdriver
      use modmpi,      only : myid, comm3d, mpierr, nprocx, nprocy
      use modglobal,   only : idriver
      implicit none
      real :: d(1:itot-1)
      logical :: inequi

      if (mod(jtot, nprocy) /= 0) then
         if (myid == 0) then
            write (0, *) 'STOP ERROR IN NUMBER OF PROCESSORS'
            write (0, *) 'nprocy must divide jtot!!! '
            write (0, *) 'nprocy and jtot are: ', nprocy, jtot
         end if
         call MPI_FINALIZE(mpierr)
         stop 1
      end if

      if (ipoiss==POISS_FFT2D) then
        if(mod(itot,nprocx)/=0)then
          if(myid==0)then
            write(0,*)'STOP ERROR IN NUMBER OF PROCESSORS'
            write(0,*)'nprocx must divide itot!!! '
            write(0,*)'nprocx and itot are: ',nprocx,itot
          end if
          call MPI_FINALIZE(mpierr)
          stop 1
        end if
      end if

      if (mod(ktot, nprocy) /= 0) then ! Only when doing CR
         if (myid == 0) then
            write (0, *) 'STOP ERROR IN NUMBER OF PROCESSORS'
            write (0, *) 'nprocs must divide ktot!!! '
            write (0, *) 'nprocs and ktot are: ', nprocy, ktot
         end if
         call MPI_FINALIZE(mpierr)
         stop 1
      end if

      !Check Namoptions
      if (runtime < 0) then
         write(0, *) 'ERROR: runtime out of range/not set'
         stop 1
      end if
      if (dtmax < 0) then
         write(0, *) 'ERROR: dtmax out of range/not set'
         stop 1
      end if
      if (ps < 0) then
         write(0, *) 'ERROR: psout of range/not set'
         stop 1
      end if
      if (xlen < 0) then
         write(0, *) 'ERROR: xlen out of range/not set'
         stop 1
      end if
      if (ylen < 0) then
         write(0, *) 'ERROR: ylen out of range/not set'
         stop 1
      end if

      if ((lwarmstart) .or. (lstratstart)) then
         if (startfile == '') then
            write(0, *) 'ERROR: no restartfile set'
            stop 1
         end if
      end if

      ! Call neutral wall function when air temperature not evolved or if constant heat flux.
      if (((ltempeq .eqv. .false.) .or. (iwalltemp==1)) .and. (iwallmom==2)) then
        if (myid==0) write(*,*) "Changing to neutral wall function"
         iwallmom = 3
         BCbotm = BCbotm_wfneutral
      end if

      select case(BCxm)
      case(BCxm_periodic)
        !if (myid == 0) write(*,*) "Periodic boundary conditions for velocity in x direction"

        if (ltempeq .and. (BCxT .ne. BCxT_periodic) .and. (myid == 0)) then
          write (*, *) "Warning: temperature not periodic in x, consider setting BCxT = ", BCxT_periodic
        end if

        if (lmoist .and. (BCxq .ne. BCxq_periodic) .and. (myid == 0)) then
          write (*, *) "Warning: moisture not periodic in x, consider setting BCxq = ", BCxq_periodic
        end if

      case(BCxm_profile)
         linoutflow = .true.
         call MPI_BCAST(linoutflow, 1, MPI_LOGICAL, 0, comm3d, mpierr)

         !if (myid == 0) write(*, *) "x inflow velocity given by profile"

         if (ltempeq .and. (BCxT .ne. BCxT_profile) .and. (myid == 0)) then
           write (*, *) "Warning: x inflow temperature not given by profile, &
                         &consider setting BCxT = ", BCxT_profile
         end if

         if (lmoist .and. (BCxq .ne. BCxq_profile) .and. (myid == 0)) then
           write (*, *) "Warning: x inflow moisture not given by profile, &
                        &consider setting BCxq = ", BCxq_profile
         end if

         if (BCtopm .ne. BCtopm_pressure) then
           if (myid==0) write (*, *) "inflow-outflow: allowing vertical velocity at top, setting BCtopm = 3"
           BCtopm = BCtopm_pressure
         end if

       case(BCxm_driver)
         linoutflow = .true.
         idriver = 2
         call MPI_BCAST(linoutflow, 1, MPI_LOGICAL, 0, comm3d, mpierr)
         call MPI_BCAST(idriver, 1, MPI_INTEGER, 0, comm3d, mpierr)

         !if (myid == 0) write (*, *) "x inflow velocity given by file from precursor simulation"

         if (ltempeq) then
           if (BCxT == BCxT_driver) then
             lhdriver = .true.
           else
             lhdriver = .false.
             if (myid==0) write (*, *) "Warning: x inflow temperature not given by precursor."
           end if
         end if

         if (lmoist) then
           if (BCxq == BCxq_driver) then
             lqdriver = .true.
           else
             lqdriver = .false.
             if (myid==0) write (*, *) "Warning: x inflow humidity not given by precursor."
           end if
         end if

         if (nsv > 0) then
           if (BCxs == BCxs_driver) then
             lsdriver = .true.
           else
             lsdriver = .false.
             if (myid == 0) write (*, *) "Warning: x inflow scalars not given by precursor."
           end if
         end if

         if (BCtopm .ne. BCtopm_pressure) then
            if (myid == 0) write (*, *) "inflow-outflow: allowing vertical velocity at top, setting BCtopm = 3"
            BCtopm = BCtopm_pressure
         end if
      end select

      select case(BCym)
      case(BCym_periodic)
        !if (myid == 0) write(*,*) "Periodic boundary conditions for velocity in y direction"

        if (ltempeq .and. (BCyT .ne. BCyT_periodic) .and. (myid == 0)) then
          write (*, *) "Warning: temperature not periodic in y, consider setting BCxT = ", BCxT_periodic
        end if

        if (lmoist .and. (BCyq .ne. BCyq_periodic) .and. (myid == 0)) then
          write (*, *) "Warning: moisture not periodic in y, consider setting BCxq = ", BCxq_periodic
        end if

      case(BCxm_profile)
         linoutflow = .true.
         call MPI_BCAST(linoutflow, 1, MPI_LOGICAL, 0, comm3d, mpierr)

         !if (myid == 0) write(*, *) "y inflow velocity given by profile"

         if (ltempeq .and. (BCyT .ne. BCyT_profile) .and. (myid == 0)) then
           write (*, *) "Warning: y inflow temperature not given by profile, &
                         &consider setting BCyT = ", BCyT_profile
         end if

         if (lmoist .and. (BCyq .ne. BCyq_profile) .and. (myid == 0)) then
           write (*, *) "Warning: y inflow moisture not given by profile, &
                        &consider setting BCyq = ", BCyq_profile
         end if

         if (BCtopm .ne. BCtopm_pressure .and. (myid == 0)) then
           write (*, *) "Warning: allowing vertical velocity at top might be necessary, &
                         &consider setting BCtopm = ", BCtopm_pressure
         end if
       end select

       if ((lydump .or. lytdump) .and. (nprocx > 1)) then
          write(*, *) "Error: y-averaged statistics not currently implemented for nprocx > 1."
          stop 1
       end if

       if ((luoutflowr) .and. (nprocx > 1)) then
          write(*, *) "Error: constant x outflow only possible for nprocx = 1."
          stop 1
       end if

       if ((lvoutflowr) .and. (nprocy > 1)) then
          write(*, *) "Error: constant y outflow only possible for nprocy = 1."
          stop 1
       end if

   end subroutine checkinitvalues