cntrl_prmtrs.f90

Go to the documentation of this file.

!/===========================================================================/
! Copyright (c) 2007, The University of Massachusetts Dartmouth 
! Produced at the School of Marine Science & Technology 
! Marine Ecosystem Dynamics Modeling group
! All rights reserved.
!
! FVCOM has been developed by the joint UMASSD-WHOI research team. For 
! details of authorship and attribution of credit please see the FVCOM
! technical manual or contact the MEDM group.
!
! 
! This file is part of FVCOM. For details, see http://fvcom.smast.umassd.edu 
! The full copyright notice is contained in the file COPYRIGHT located in the 
! root directory of the FVCOM code. This original header must be maintained
! in all distributed versions.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
! AND ANY EXPRESS OR  IMPLIED WARRANTIES, INCLUDING,  BUT NOT  LIMITED TO,
! THE IMPLIED WARRANTIES OF MERCHANTABILITY AND  FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED.  
!
!/---------------------------------------------------------------------------/
! CVS VERSION INFORMATION
! $Id$
! $Name$
! $Revision$
!/===========================================================================/

SUBROUTINE cntrl_prmtrs
  USE lims
  USE control
  USE mod_utils
  USE mod_assim
  USE mod_time
  USE mod_ncdio
  USE mod_nesting
  IMPLICIT NONE
  LOGICAL TEST
  integer :: stat,ierr


  ! SIMPLE SETTINGS FROM RUN FILE ETC SHOULD GO HERE!

  IF (msr) use_proj = have_proj(projection_reference)
  IF (use_proj) THEN
     if(dbg_set(dbg_log)) write(ipt,*) "! PROJ 4 CARTOGRAPHIC PROJECTION ENABLED!"
  ELSE
     if(dbg_set(dbg_log)) write(ipt,*) "! PROJ 4 CARTOGRAPHIC PROJECTION DISABLED!"
  END IF



  If(ice_model) CALL fatal_error &
       & ('You must compile with ICE to use it!',&
       & 'Recompile after selecting it in the make file,',&
       & 'or turn it off in the run file')



!  write(ipt,*)  "PRG_NAME='"//trim(prg_name)//"'"


  IF(trim(prg_name) == "FVCOM") THEN

     ! TRANSLATE TO OLD FVCOM PARAMTER NAMES
     
     ! SET THE FVCOM NAMES FOR MIXING TERMS
     umol   = vertical_mixing_coefficient
     if (umol .LT. 0) CALL fatal_error&
          &("Name List Error: VERTICAL_MIXING_COEFFICIENT outside valid range")
     vprnu  = vertical_prandtl_number
     if (vprnu .LT. 0) CALL fatal_error&
          &("Name List Error: VERTICAL_PRANDTL_NUMBER outside valid range")
     
     if (horizontal_mixing_kind .eq. sttc) THEN
        if (horizontal_mixing_coefficient .NE. -1.0_sp)THEN
           CALL warning("The name list variable: HORIZONTAL_MIXING_COEFFICIENT",&
                "should have the default value when the horizontal mixing is set using 'static'",&
                "(ie set from an input file!)")
           
           horizontal_mixing_coefficient = -1.0_sp
        end if
        
     else if(horizontal_mixing_kind .eq. cnstnt) THEN
        
        if (horizontal_mixing_coefficient .LT. 0.0_sp) CALL fatal_error&
             &("The name list variable: HORIZONTAL_MIXING_COEFFICIENT",&
             & "Can not have the default value -1.0 when the horizontal mixing is set using 'constant'",&
             & "(ie set the viscosity in the model!)")
     else
        CALL fatal_error&
             &("The name list variable: HORIZONTAL_MIXING_KIND",&
             & "Is set to an invalid option: (choices: constant, static)")     
     end if
     
     hprnu  = horizontal_prandtl_number
     if (hprnu .LT. 0) CALL fatal_error&
          &("Name List Error: HORIZONTAL_PRANDTL_NUMBER outside valid range")
     
     
     cbcmin = bottom_roughness_minimum
     if (cbcmin .LT. 0) CALL fatal_error&
          &("Name List Error: BOTTOM_ROUGHNESS_MINIMUM outside valid range")
     

     IF (bottom_roughness_kind .eq. sttc) THEN
        if (bottom_roughness_lengthscale .NE. -1.0_sp)THEN
           CALL warning("The name list variable: BOTTOM_ROUGHNESS_LENGTHSCALE",&
                "should have the default value when the bottom roughness is set using 'static'",&
                "(ie set from an input file!)")
           
           bottom_roughness_lengthscale = bottom_roughness_lengthscale
        end if
        
     else if(bottom_roughness_kind .eq. cnstnt) THEN
        
        if (bottom_roughness_lengthscale .LE. 0.0_sp) CALL fatal_error&
             &("The name list variable: BOTTOM_ROUGHNESS_LENGTHSCALE",&
             & "Can not have the default value -1.0 when the bottom roughness is set using 'constant'")
     else
        CALL fatal_error&
             &("The name list variable: BOTTOM_ROUGHNESS_KIND",&
             & "Is set to an invalid option: (choices: constant, static)")     
     end if

     
     
     ! FIX SCALAR_POSITIVITY_CONTROL and HEATING_TYPE SETTINGS
     IF (heating_on) THEN

        ! SET THE FVCOM NAMES FOR SURFACE HEATING
        rheat = heating_longwave_perctage
        if (rheat .LT. 0) CALL fatal_error&
             &("Name List Error: HEATING_LONGWAVE_PERCTAGE outside valid range")
        
        zeta1 = heating_longwave_lengthscale
        if (zeta1 .LT. 0) CALL fatal_error&
             &("Name List Error: HEATING_LONGWAVE_LENGTHSCALE outside valid range")
        
        zeta2 = heating_shortwave_lengthscale
        if (zeta2 .LT. 0) CALL fatal_error&
             &("Name List Error: HEATING_SHORTWAVE_LENGTHSCALE outside valid range")
        
        
        IF(scalar_positivity_control .AND. (heating_type == 'body')) THEN
           CALL fatal_error &
                &("YOU CAN NOT USE SCALAR POSITIVITY CONTROL WITH BODY HEATING")
        END IF
     ELSE 
        heating_type = 'none'
        rheat=0.0_sp
        zeta1=0.0_sp
        zeta2=0.0_sp
     END IF
     
     
     IF( .not. obc_on .or. .not. obc_elevation_forcing_on) THEN
        IF (obc_longshore_flow_on) THEN
           CALL fatal_error &
                &("YOU CAN NOT USE THE LONGSHORE FLOW BOUNDRY ADJUSTMENT &
                &WITHOUT OPEN BOUNDARY ELEVATION FORCING!")
        END IF
     END IF
     
     ! SET DEFAULT RUN MODE - DATA ASSIMILATION IS OFF
     fvcom_run_mode = fvcom_pure_sim
     !==============================================================================!
     !  READ DATA ASSIMILATION NAMELIST AND SET PARAMETERS                          !
     !==============================================================================!
     IF (data_assimilation) THEN
        if(dbg_set(dbg_log)) WRITE(ipt,*) "! STARTING DATA ASSIMILATION MODE "
     ELSE
        if(dbg_set(dbg_log)) WRITE(ipt,*) "! DATA ASSIMILATION MODE IS OFF "
     END IF
     
  END IF


  ! SET DEFAULT TO TRUE FOR REAL TIME MODEL
  use_real_world_time = .true.
  ! TEST FOR IDEALIZED MODEL CASE
  if (timezone == 'none' .or. timezone == "NONE" .or.&
       & timezone == "None") use_real_world_time = .false.


  ! CHECK FOR VALID TIME ZONE
  test = is_valid_timezone(timezone)
  IF(.not. test) call fatal_error("You selected an invalid time zone: "&
             &//trim(timezone),"Time Zones must be CAPITALS",&
             & "see mod_time.F for a list of valid time_zones")

  call register_func(dump_nc_dat,nc_code,stat)
  IF (stat/=0) CALL fatal_error("REGISTER_FUNC: FAILED TO REGISTER:: DUMP_NC_DAT")

  call register_func(dump_nc_rst,restart_code,stat)
  IF (stat/=0) CALL fatal_error("REGISTER_FUNC: FAILED TO REGISTER:: DUMP_NC_RST")

  call register_func(dump_nc_avg,ncav_code,stat)
  IF (stat/=0) CALL fatal_error("REGISTER_FUNC: FAILED TO REGISTER:: DUMP_NC_AVG")

  call register_func(init_ncdio,init_code,stat)
  IF (stat/=0) CALL fatal_error("REGISTER_FUNC: FAILED TO REGISTER:: INIT_NCDIO")



  !//////////////////////////////////////////////////////////////////
  !//////////////////////////////////////////////////////////////////
  !==============================================================================!
  !  LOAD THE VISIT LIBRARIES AND DUMP SIM FILE                                  !
  !==============================================================================!
  Call init_visit


  !//////////////////////////////////////////////////////////////////
  !//////////////////////////////////////////////////////////////////


END SUBROUTINE cntrl_prmtrs