mod_setup Module Reference

Functions/Subroutines
subroutine	setup_center_coords
subroutine	setup_horizontal_mixing_coefficient
subroutine	setup_bottom_roughness
subroutine	setup_depth
subroutine	setup_coriolis
subroutine	setup_gravity
subroutine	setup_sponge
subroutine	coordinate_units (XL, YL)
subroutine	setup_sigma
subroutine	setup_sigma_derivatives

Variables
real(sp), dimension(:), allocatable, target	x_gbl
real(sp), dimension(:), allocatable, target	y_gbl
real(sp), dimension(:), allocatable, target	x_lcl
real(sp), dimension(:), allocatable, target	y_lcl
real(sp), dimension(:), allocatable, target	c_lcl
real(sp), dimension(:), allocatable, target	h_lcl
integer, dimension(:), allocatable, target	n_spg
real(sp), dimension(:), allocatable, target	r_spg
real(sp), dimension(:), allocatable, target	c_spg
real(sp), dimension(:), allocatable, target	x_spg
real(sp), dimension(:), allocatable, target	y_spg
integer	nsponge

Function/Subroutine Documentation

coordinate_units()

subroutine mod_setup::coordinate_units	(	real(sp), dimension(:), allocatable	XL,
		real(sp), dimension(:), allocatable	YL
	)

Definition at line 300 of file mod_setup.f90.

    IMPLICIT NONE
    REAL(SP), ALLOCATABLE :: XL(:),YL(:)
    integer status, ierr


    REAL(SP), allocatable :: x_buf(:), lon_buf(:)
    REAL(SP), allocatable :: y_buf(:), lat_buf(:)

    IF(dbg_set(dbg_sbr)) write(ipt,*) "COODINATE_UNITS: START"

!! IF NOT SPHERICAL CASE
    
    IF (grid_file_units == 'degrees') THEN
       
       IF (use_proj) THEN
          
          lon = xl
          lat = yl
          
          ! USE PROJECTION TOOL BOX TO CONVERT TO METERS
        IF (serial) THEN
           CALL degrees2meters(xl(1:mt),yl(1:mt), &
               & projection_reference,vx(1:mt),vy(1:mt),mt)
        END IF         
          xm = vx
          ym = vy
          
       ELSE
          
          CALL fatal_error('You must specify a valid projection reference'&
               &,'and compile with PROJ to use files with latitude and longitue in cartesian mode')
       END IF
       

    ELSE IF(grid_file_units == 'meters') THEN

       vx = xl
       vy = yl
       
       xm = xl
       ym = yl
       
       ! USE PROJECTION TOOL BOX TO CONVERT TO DEGREES
       IF (use_proj ) THEN
        IF (serial) THEN
           CALL meters2degrees(xl(1:mt),yl(1:mt), &
            & projection_reference,lon(1:mt),lat(1:mt),mt)
        END IF
          
       END IF

    ELSE 
       CALL fatal_error('UNRECOGNIZED GRID_FILE_UNITS: '//trim(grid_file_units))
       
    END IF


    IF(dbg_set(dbg_sbr)) write(ipt,*) "COODINATE_UNITS: END"
    

Here is the call graph for this function:

Here is the caller graph for this function:

setup_bottom_roughness()

subroutine mod_setup::setup_bottom_roughness

(

)

Definition at line 166 of file mod_setup.f90.

    IMPLICIT NONE
  
    if (bottom_roughness_kind .eq. sttc) THEN
  
       if(dbg_set(dbg_log)) then
          write(ipt,*) "! "
          write(ipt,*) "! Setting Staticly Variable Bottom Roughness"
       end if

       CALL load_bottom_roughness(cc_z0b)
              
    else if(bottom_roughness_kind .eq. cnstnt) THEN
       
       cc_z0b    = bottom_roughness_lengthscale
       cc_z0b(0) = 0.0_sp
       
    else
       CALL fatal_error&
            &("HORIZONTAL_MIXING_KIND ERROR",&
            & "This should not happen")
       
    end if
    
    

Here is the call graph for this function:

Here is the caller graph for this function:

setup_center_coords()

subroutine mod_setup::setup_center_coords

(

)

Definition at line 74 of file mod_setup.f90.

    USE mod_spherical
    IMPLICIT NONE
    INTEGER I,J,IERR,STATUS,SENDID
    REAL(SP) SBUF

    INTEGER K,ITMP
    REAL(DP) VX1,VY1,VX2,VY2,VX3,VY3
    REAL(DP) EVX12,EVX13,EVX23,EVY12,EVY13,EVY23,EVXY
    REAL(DP) VX12,VY12,VX23,VY23,VX31,VY31
    INTEGER :: SENDER

    ! David Added:
    REAL(SP), allocatable :: xc_buf(:), lonc_buf(:)
    REAL(SP), allocatable :: yc_buf(:), latc_buf(:)
 
    IF(dbg_set(dbg_sbr)) write(ipt,*) "SETUP_CENTER_COORDS: START"
    
    
!==============================================================================|
!   SET UP LOCAL MESH (HORIZONTAL COORDINATES)                                 |
!==============================================================================|
!--------------CALCULATE GLOBAL MINIMUMS AND MAXIMUMS--------------------------!
    
! IF THIS IS NOT A SPHERICAL MODEL REMOVE MIN COORDINATE VALUE    
    
    vxmin = minval(vx(1:mt)) ; vxmax = maxval(vx(1:mt))
    vymin = minval(vy(1:mt)) ; vymax = maxval(vy(1:mt))
    
    !--------------SHIFT GRID TO UPPER RIGHT CARTESIAN-----------------------------!
    
    vx = vx - vxmin
    vy = vy - vymin
    vx(0) = 0.0_sp ; vy(0) = 0.0_sp
    
    !--------------CALCULATE GLOBAL ELEMENT CENTER GRID COORDINATES----------------!
    CALL n2e2d(vx,xc)
    CALL n2e2d(vy,yc)
    
    xmc = xc + vxmin
    xmc(0)= 0.0_sp
    ymc = yc + vymin
    ymc(0)= 0.0_sp

    IF (use_proj ) THEN
        IF (serial) THEN
           CALL meters2degrees(xmc(1:nt),ymc(1:nt)&
                &   ,projection_reference,lonc(1:nt),latc(1:nt),nt)
        END IF

    END IF

    

    IF(dbg_set(dbg_sbr)) write(ipt,*) "SETUP_CENTER_COORDS: END"

Here is the call graph for this function:

Here is the caller graph for this function:

setup_coriolis()

subroutine mod_setup::setup_coriolis

(

)

Definition at line 214 of file mod_setup.f90.

    IMPLICIT NONE
    integer:: I
    !--------------READ IN CORIOLIS PARAMETER--------------------------------------!

    IF(dbg_set(dbg_sbr)) write(ipt,*) "SETUP_CORIOLIS: START"

    CALL n2e2d(c_lcl,cor)


    cor = 2.*7.292e-5_sp * sin(cor * deg2rad)
    
    !!  ggao for equatoral min (4deg)
    IF(.NOT. equator_beta_plane)THEN
     WHERE(cor <  1.e-5_sp .AND. cor > 0.0_sp) cor =  1.e-5_sp
     WHERE(cor > -1.e-5_sp .AND. cor < 0.0_sp) cor = -1.e-5_sp
    END IF 

    IF(dbg_set(dbg_sbr)) write(ipt,*) "SETUP_CORIOLIS: END"

Here is the call graph for this function:

Here is the caller graph for this function:

setup_depth()

subroutine mod_setup::setup_depth

(

)

Definition at line 195 of file mod_setup.f90.

    IMPLICIT NONE
    INTEGER :: IERR
    REAL(SP):: SBUF
    
    IF(dbg_set(dbg_sbr)) write(ipt,*) "SETUP_DEPTH: START"
    hmax = maxval(h_lcl(1:mt))
    hmin = minval(h_lcl(1:mt))


    h = h_lcl

    IF(dbg_set(dbg_sbr)) write(ipt,*) "SETUP_DEPTH: END"

Here is the call graph for this function:

Here is the caller graph for this function:

setup_gravity()

subroutine mod_setup::setup_gravity

(

)

Definition at line 241 of file mod_setup.f90.

    IMPLICIT NONE
    INTEGER I

    IF(dbg_set(dbg_sbr)) write(ipt,*) "SETUP_GRAVITY: START"

    grav_n = grav
    grav_e = grav

    IF(dbg_set(dbg_sbr)) write(ipt,*) "SETUP_GRAVITY: END"

Here is the call graph for this function:

Here is the caller graph for this function:

setup_horizontal_mixing_coefficient()

subroutine mod_setup::setup_horizontal_mixing_coefficient

(

)

Definition at line 134 of file mod_setup.f90.

    IMPLICIT NONE
  
    if (horizontal_mixing_kind .eq. sttc) THEN

       if(dbg_set(dbg_log)) then
          write(ipt,*) "! "
          write(ipt,*) "! Setting Staticly Variable viscosity"
       end if

       CALL load_horizontal_mixing_coefficient(nn_hvc,cc_hvc)
       
       
    else if(horizontal_mixing_kind .eq. cnstnt) THEN
       
       cc_hvc=horizontal_mixing_coefficient
       cc_hvc(0)=0.0_sp
       nn_hvc=horizontal_mixing_coefficient
       nn_hvc(0)=0.0_sp
       
    else
       CALL fatal_error&
            &("HORIZONTAL_MIXING_KIND ERROR",&
            & "This should not happen")
       
    end if
    
    

Here is the call graph for this function:

Here is the caller graph for this function:

setup_sigma()

subroutine mod_setup::setup_sigma

(

)

Definition at line 403 of file mod_setup.f90.

    !==============================================================================|
    IMPLICIT NONE
    INTEGER :: K,KK
    INTEGER :: I
    REAL(SP):: ZTMP(KB)
    REAL(SP):: X1,X2,X3  
    REAL(SP):: DR,RCL,RCU
    !==============================================================================|

    IF(dbg_set(dbg_sbr)) WRITE(ipt,*)"SETUP_SIGMA: START"

    IF(dbg_set(dbg_sbrio)) THEN
       WRITE(ipt,*)"==================="
       WRITE(ipt,*)"  SET_SIGMA IO"
       WRITE(ipt,*)"  STYPE = "//trim(stype)
       WRITE(ipt,*)"  P_SIGMA = ", p_sigma
       WRITE(ipt,*)"  KB = ", kb
       WRITE(ipt,*)"==================="
    END IF

    !---------------------------------------------
    !---------------------------------------------
    SELECT CASE(stype)
    !---------------------------------------------
    !SIGMA_COORDINATE_TYPE = UNIFORM (DEGENERATE CASE OF GEOMETRIC)
    CASE(stype_uniform)
    !---------------------------------------------
       IF(p_sigma > 1 .AND. mod(kb,2) == 0) &
            CALL fatal_error('SETUP_SIGMA: COORDINATE TYPE:'//trim(stype)&
            &,'kb shoude be an odd number for this type of sigma coordinates....' )
       CALL sigma_geometric
    !---------------------------------------------
    !SIGMA_COORDINATE_TYPE = GEOMETRIC
    CASE(stype_geometric)
    !---------------------------------------------

       IF(p_sigma > 1 .AND. mod(kb,2) == 0) &
            CALL fatal_error('SETUP_SIGMA: COORDINATE TYPE:'//trim(stype)&
            &,'kb shoude be an odd number for this type of sigma coordinates....' )
       CALL sigma_geometric
    !---------------------------------------------
    ! SIGMA_COORDINATE_TYPE = TANH
    CASE(stype_tanh)
    !---------------------------------------------   
       CALL sigma_tanh
    !---------------------------------------------   
    !SIGMA_COORDINATE_TYPE = GENERALIZED
    CASE(stype_generalized)
    !---------------------------------------------   
       CALL sigma_generalized

    ! THIS IS A CURRENTLY UNUSED METHOD
!!$!---------------------------------------------   
!!$!SIGMA_COORDINATE_TYPE = WHAT THE HELL IS THIS?
!!$   CASE("UNKNOWN")
!!$!---------------------------------------------   
!!$
!!$    CALL SIGMA_UNKNOWN
    CASE DEFAULT
       CALL fatal_error("SET_SIGMA: REACHED DEFAULT CASE FOR SIGMA COOR&
            &DINATE TYPE")
    END SELECT

    !---------COMPUTE SIGMA DERIVATIVES AND INTRA SIGMA LEVELS---------------------!

    IF(dbg_set(dbg_sbr)) WRITE(ipt,*)"SETUP_SIGMA: END"

    RETURN

Here is the call graph for this function:

Here is the caller graph for this function:

setup_sigma_derivatives()

subroutine mod_setup::setup_sigma_derivatives

(

)

Definition at line 636 of file mod_setup.f90.

    USE all_vars
    IMPLICIT NONE
    INTEGER :: K, I


    IF(dbg_set(dbg_sbr)) WRITE(ipt,*)"SETUP_SIGMA_DERIVATIVES: START"

    DO k=1,kb-1
       DO i=1,mt
          dz(i,k)  = z(i,k)-z(i,k+1)
          zz(i,k)  = .5_sp*(z(i,k)+z(i,k+1))
       END DO
       DO i=1,nt
          dz1(i,k)  = z1(i,k)-z1(i,k+1)
          zz1(i,k)  = .5_sp*(z1(i,k)+z1(i,k+1))
       END DO
    END DO

    DO i=1,mt
       zz(i,kb) = 2.0_sp*zz(i,kb-1)-zz(i,kb-2)
    END DO
    DO i=1,nt
       zz1(i,kb) = 2.0_sp*zz1(i,kb-1)-zz1(i,kb-2)
    END DO

    DO k=1,kbm2
       DO i=1,mt
          dzz(i,k) = zz(i,k)-zz(i,k+1)
       END DO
       DO i=1,nt
          dzz1(i,k) = zz1(i,k)-zz1(i,k+1)
       END DO
    END DO

    dzz(:,kbm1) = 0.0_sp
    dz(:,kb)    = 0.0_sp
    dzz1(:,kbm1) = 0.0_sp
    dz1(:,kb)    = 0.0_sp


    !----------OUTPUT VALUES-TO INFOFILE-------------------------------------------!

    IF(dbg_set(dbg_log)) THEN
       WRITE(ipt,*  )'!'
       WRITE(ipt,*  )'!'
       WRITE(ipt,*)'!                SIGMA LAYER INFO     '
       WRITE(ipt,*) "SIGMA TYPE:",trim(stype)
       WRITE(ipt,70)
       SELECT CASE(stype)
       CASE(stype_uniform)
          DO k=1,kb
             WRITE(ipt,80) k,z(1,k),zz(1,k),dz(1,k),dzz(1,k)
          END DO
       CASE(stype_restart)
          DO k=1,kb
             WRITE(ipt,80) k,z(1,k),zz(1,k),dz(1,k),dzz(1,k)
          END DO
       CASE(stype_geometric)
          DO k=1,kb
             WRITE(ipt,80) k,z(1,k),zz(1,k),dz(1,k),dzz(1,k)
          END DO
       CASE(stype_tanh)
          DO k=1,kb
             WRITE(ipt,80) k,z(1,k),zz(1,k),dz(1,k),dzz(1,k)
          END DO
       CASE(stype_generalized) ! THIS IS CASE SPECIFIC 
          WRITE(ipt,*)"SET CASE SPECIFIC GENERALIZED SIGMA LAYER OUTPUT TO SCREEN &
               &IN mod_setup.F"
       END SELECT
       WRITE(ipt,*  )'!'
    END IF

    IF(dbg_set(dbg_sbr)) WRITE(ipt,*)"END SETUP_SIGMA_DERIVATIVES"

    !----------FORMAT STATEMENTS---------------------------------------------------!

70  FORMAT(2x,'k',13x,'z',11x,'zz',11x,'dz',11x,'dzz')
80  FORMAT(' ',i5,4f13.8)


    IF(dbg_set(dbg_sbr)) WRITE(ipt,*)"SETUP_SIGMA_DERIVATIVES: END"

Here is the call graph for this function:

Here is the caller graph for this function:

setup_sponge()

subroutine mod_setup::setup_sponge

(

)

Definition at line 257 of file mod_setup.f90.

    USE mod_spherical
    IMPLICIT NONE
    REAL(SP)  TEMP,DTMP,C_SPONGE
    INTEGER :: I1, I, SENDER, IERR
    REAL(DP) X1_DP,Y1_DP,X2_DP,Y2_DP,DTMP_DP

    !--SET SPONGE PARAMETERS-------------------------------------------------------|
    
    IF(dbg_set(dbg_sbr)) write(ipt,*) "SETUP_SPONGE: START"

    IF (nsponge ==0) RETURN

! NOTE: X_SPG/Y_SPG COORDINATES MUST BE AJUSTED FOR VXMIN/VYMIN

    x_spg = x_spg - vxmin
    y_spg = y_spg - vymin

    DO i=1,nt
       DO i1=1,nsponge
          dtmp=(xc(i)-x_spg(i1))**2+(yc(i)-y_spg(i1))**2
          dtmp=sqrt(dtmp)/r_spg(i1)

          IF(dtmp <= 1.0_sp) THEN
             c_sponge=c_spg(i1)*(1.0_sp-dtmp)
             cc_sponge(i)=max(c_sponge,cc_sponge(i))
          END IF
       END DO
    END DO


    DEALLOCATE(n_spg,r_spg,c_spg,x_spg,y_spg)

    IF(dbg_set(dbg_sbr)) write(ipt,*) "SETUP_SPONGE: END"
    
    RETURN

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

c_lcl

real(sp), dimension(:), allocatable, target mod_setup::c_lcl

Definition at line 58 of file mod_setup.f90.

  REAL(SP), ALLOCATABLE, TARGET :: C_LCL(:)     !!CORIOLIS PARAMETER AT NODES

c_spg

real(sp), dimension(:), allocatable, target mod_setup::c_spg

Definition at line 65 of file mod_setup.f90.

h_lcl

real(sp), dimension(:), allocatable, target mod_setup::h_lcl

Definition at line 61 of file mod_setup.f90.

  REAL(SP), ALLOCATABLE, TARGET :: H_LCL(:)     !! DEPTH PARAMETER AT NODES

n_spg

integer, dimension(:), allocatable, target mod_setup::n_spg

Definition at line 64 of file mod_setup.f90.

  INTEGER, ALLOCATABLE, TARGET  :: N_SPG(:)

nsponge

integer mod_setup::nsponge

Definition at line 66 of file mod_setup.f90.

  INTEGER :: NSPONGE

r_spg

real(sp), dimension(:), allocatable, target mod_setup::r_spg

Definition at line 65 of file mod_setup.f90.

  REAL(SP), ALLOCATABLE, TARGET :: R_SPG(:),C_SPG(:),X_SPG(:),Y_SPG(:)

x_gbl

real(sp), dimension(:), allocatable, target mod_setup::x_gbl

Definition at line 54 of file mod_setup.f90.

  REAL(SP), ALLOCATABLE, TARGET :: X_GBL(:),Y_GBL(:)

x_lcl

real(sp), dimension(:), allocatable, target mod_setup::x_lcl

Definition at line 55 of file mod_setup.f90.

  REAL(SP), ALLOCATABLE, TARGET :: X_LCL(:),Y_LCL(:)

x_spg

real(sp), dimension(:), allocatable, target mod_setup::x_spg

Definition at line 65 of file mod_setup.f90.

y_gbl

real(sp), dimension(:), allocatable, target mod_setup::y_gbl

Definition at line 54 of file mod_setup.f90.

y_lcl

real(sp), dimension(:), allocatable, target mod_setup::y_lcl

Definition at line 55 of file mod_setup.f90.

y_spg

real(sp), dimension(:), allocatable, target mod_setup::y_spg

Definition at line 65 of file mod_setup.f90.