Changeset 5993


Ignore:
Timestamp:
2015-12-03T14:55:36+01:00 (5 years ago)
Author:
timgraham
Message:

Applied changes as suggested by reviewer

Location:
branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/scoord_gen.F90

    r5794 r5993  
    339339      z_gsigw3  = 0.   ;   z_gsigt3  = 0.   ;   z_gsi3w3  = 0. 
    340340      z_esigt3  = 0.   ;   z_esigw3  = 0.  
    341       z_esigt3p1  = 0. ;   z_esigw3p1  = 0.  
    342341      z_esigtu3 = 0.   ;   z_esigtv3 = 0.   ;   z_esigtf3 = 0. 
    343342      z_esigwu3 = 0.   ;   z_esigwv3 = 0. 
     
    664663 
    665664   END SUBROUTINE s_tanh 
    666  
    667    FUNCTION fssig( pk ) RESULT( pf ) 
    668       !!---------------------------------------------------------------------- 
    669       !!                 ***  ROUTINE fssig *** 
    670       !!        
    671       !! ** Purpose :   provide the analytical function in s-coordinate 
    672       !!           
    673       !! ** Method  :   the function provide the non-dimensional position of 
    674       !!                T and W (i.e. between 0 and 1) 
    675       !!                T-points at integer values (between 1 and jpk) 
    676       !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5) 
    677       !!---------------------------------------------------------------------- 
    678       USE utils, ONLY : wp,rn_theta,rn_thetb,jpk 
    679       IMPLICIT NONE 
    680       REAL(wp), INTENT(in) ::   pk   ! continuous "k" coordinate 
    681       REAL(wp)             ::   pf   ! sigma value 
    682       !!---------------------------------------------------------------------- 
    683       ! 
    684       pf =   (   TANH( rn_theta * ( -(pk-0.5) / REAL(jpk-1) + rn_thetb )  )   & 
    685          &     - TANH( rn_thetb * rn_theta                                )  )   & 
    686          & * (   COSH( rn_theta                           )                      & 
    687          &     + COSH( rn_theta * ( 2. * rn_thetb - 1. ) )  )              & 
    688          & / ( 2. * SINH( rn_theta ) ) 
    689       ! 
    690    END FUNCTION fssig 
    691  
    692  
    693    FUNCTION fssig1( pk1, pbb ) RESULT( pf1 ) 
    694       !!---------------------------------------------------------------------- 
    695       !!                 ***  ROUTINE fssig1 *** 
    696       !! 
    697       !! ** Purpose :   provide the Song and Haidvogel version of the analytical function in s-coordinate 
    698       !! 
    699       !! ** Method  :   the function provides the non-dimensional position of 
    700       !!                T and W (i.e. between 0 and 1) 
    701       !!                T-points at integer values (between 1 and jpk) 
    702       !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5) 
    703       !!---------------------------------------------------------------------- 
    704       USE utils, ONLY : wp, jpk, rn_theta 
    705       IMPLICIT NONE 
    706       REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate 
    707       REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient 
    708       REAL(wp)             ::   pf1   ! sigma value 
    709       !!---------------------------------------------------------------------- 
    710       ! 
    711       IF ( rn_theta == 0 ) then      ! uniform sigma 
    712          pf1 = - ( pk1 - 0.5 ) / REAL( jpk-1 ) 
    713       ELSE                        ! stretched sigma 
    714          pf1 =   ( 1. - pbb ) * ( SINH( rn_theta*(-(pk1-0.5)/REAL(jpk-1)) ) ) / SINH( rn_theta )              & 
    715             &  + pbb * (  (TANH( rn_theta*( (-(pk1-0.5)/REAL(jpk-1)) + 0.5) ) - TANH( 0.5 * rn_theta )  )  & 
    716             &        / ( 2. * TANH( 0.5 * rn_theta ) )  ) 
    717       ENDIF 
    718       ! 
    719    END FUNCTION fssig1 
    720  
    721  
    722    FUNCTION fgamma( pk1, pzb, pzs, psmth) RESULT( p_gamma ) 
    723       !!---------------------------------------------------------------------- 
    724       !!                 ***  ROUTINE fgamma  *** 
    725       !! 
    726       !! ** Purpose :   provide analytical function for the s-coordinate 
    727       !! 
    728       !! ** Method  :   the function provides the non-dimensional position of 
    729       !!                T and W (i.e. between 0 and 1) 
    730       !!                T-points at integer values (between 1 and jpk) 
    731       !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5) 
    732       !! 
    733       !!                This method allows the maintenance of fixed surface and or 
    734       !!                bottom cell resolutions (cf. geopotential coordinates)  
    735       !!                within an analytically derived stretched S-coordinate framework. 
    736       !! 
    737       !! Reference  :   Siddorn and Furner, in prep 
    738       !!---------------------------------------------------------------------- 
    739       USE utils, ONLY : jpk,wp,rn_alpha 
    740       IMPLICIT NONE 
    741       REAL(wp), INTENT(in   ) ::   pk1           ! continuous "k" coordinate 
    742       REAL(wp)                ::   p_gamma       ! stretched coordinate 
    743       REAL(wp), INTENT(in   ) ::   pzb           ! Bottom box depth 
    744       REAL(wp), INTENT(in   ) ::   pzs           ! surface box depth 
    745       REAL(wp), INTENT(in   ) ::   psmth         ! Smoothing parameter 
    746       REAL(wp)                ::   za1,za2,za3   ! local variables 
    747       REAL(wp)                ::   zn1,zn2       ! local variables 
    748       REAL(wp)                ::   za,zb,zx      ! local variables 
    749       !!---------------------------------------------------------------------- 
    750       ! 
    751  
    752       zn1  =  1./(jpk-1.) 
    753       zn2  =  1. -  zn1 
    754  
    755       za1 = (rn_alpha+2.0)*zn1**(rn_alpha+1.0)-(rn_alpha+1.0)*zn1**(rn_alpha+2.0)  
    756       za2 = (rn_alpha+2.0)*zn2**(rn_alpha+1.0)-(rn_alpha+1.0)*zn2**(rn_alpha+2.0) 
    757       za3 = (zn2**3.0 - za2)/( zn1**3.0 - za1) 
    758       
    759       za = pzb - za3*(pzs-za1)-za2 
    760       za = za/( zn2-0.5*(za2+zn2**2.0) - za3*(zn1-0.5*(za1+zn1**2.0) ) ) 
    761       zb = (pzs - za1 - za*( zn1-0.5*(za1+zn1**2.0 ) ) ) / (zn1**3.0 - za1) 
    762       zx = 1.0-za/2.0-zb 
    763  
    764       p_gamma = za*(pk1*(1.0-pk1/2.0))+zb*pk1**3.0 +  & 
    765                   & zx*( (rn_alpha+2.0)*pk1**(rn_alpha+1.0)- & 
    766                   &      (rn_alpha+1.0)*pk1**(rn_alpha+2.0) ) 
    767       p_gamma = p_gamma*psmth+pk1*(1.0-psmth) 
    768  
    769       ! 
    770    END FUNCTION fgamma 
    771  
  • branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90

    r5824 r5993  
    9898     INTEGER :: var_id, ncin 
    9999 
    100      CALL check_nf90( nf90_open('bathy.nc', NF90_NOWRITE, ncin), 'Error opening bathy.nc file' ) 
     100     CALL check_nf90( nf90_open('bathy_meter.nc', NF90_NOWRITE, ncin), 'Error opening bathy_meter.nc file' ) 
    101101 
    102102     ! Find the size of the input bathymetry 
     
    134134     INTEGER, INTENT(out)         :: len 
    135135     ! Local variables 
    136      INTEGER :: id_var, istatus 
     136     INTEGER :: id_var 
    137137 
    138138     id_var = 1 
     
    222222 
    223223   END SUBROUTINE check_nf90 
     224   FUNCTION fssig( pk ) RESULT( pf ) 
     225      !!---------------------------------------------------------------------- 
     226      !!                 ***  ROUTINE fssig *** 
     227      !!        
     228      !! ** Purpose :   provide the analytical function in s-coordinate 
     229      !!           
     230      !! ** Method  :   the function provide the non-dimensional position of 
     231      !!                T and W (i.e. between 0 and 1) 
     232      !!                T-points at integer values (between 1 and jpk) 
     233      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5) 
     234      !!---------------------------------------------------------------------- 
     235!     USE utils, ONLY : wp,rn_theta,rn_thetb,jpk 
     236      IMPLICIT NONE 
     237      REAL(wp), INTENT(in) ::   pk   ! continuous "k" coordinate 
     238      REAL(wp)             ::   pf   ! sigma value 
     239      !!---------------------------------------------------------------------- 
     240      ! 
     241      pf =   (   TANH( rn_theta * ( -(pk-0.5) / REAL(jpk-1) + rn_thetb )  )   & 
     242         &     - TANH( rn_thetb * rn_theta                                )  )   & 
     243         & * (   COSH( rn_theta                           )                      & 
     244         &     + COSH( rn_theta * ( 2. * rn_thetb - 1. ) )  )              & 
     245         & / ( 2. * SINH( rn_theta ) ) 
     246      ! 
     247   END FUNCTION fssig 
     248 
     249   FUNCTION fssig1( pk1, pbb ) RESULT( pf1 ) 
     250      !!---------------------------------------------------------------------- 
     251      !!                 ***  ROUTINE fssig1 *** 
     252      !! 
     253      !! ** Purpose :   provide the Song and Haidvogel version of the analytical function in s-coordinate 
     254      !! 
     255      !! ** Method  :   the function provides the non-dimensional position of 
     256      !!                T and W (i.e. between 0 and 1) 
     257      !!                T-points at integer values (between 1 and jpk) 
     258      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5) 
     259      !!---------------------------------------------------------------------- 
     260!     USE utils, ONLY : wp, jpk, rn_theta 
     261      IMPLICIT NONE 
     262      REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate 
     263      REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient 
     264      REAL(wp)             ::   pf1   ! sigma value 
     265      !!---------------------------------------------------------------------- 
     266      ! 
     267      IF ( rn_theta == 0 ) then      ! uniform sigma 
     268         pf1 = - ( pk1 - 0.5 ) / REAL( jpk-1 ) 
     269      ELSE                        ! stretched sigma 
     270         pf1 =   ( 1. - pbb ) * ( SINH( rn_theta*(-(pk1-0.5)/REAL(jpk-1)) ) ) / SINH( rn_theta )              & 
     271            &  + pbb * (  (TANH( rn_theta*( (-(pk1-0.5)/REAL(jpk-1)) + 0.5) ) - TANH( 0.5 * rn_theta )  )  & 
     272            &        / ( 2. * TANH( 0.5 * rn_theta ) )  ) 
     273      ENDIF 
     274      ! 
     275   END FUNCTION fssig1 
     276 
     277   FUNCTION fgamma( pk1, pzb, pzs, psmth) RESULT( p_gamma ) 
     278      !!---------------------------------------------------------------------- 
     279      !!                 ***  ROUTINE fgamma  *** 
     280      !! 
     281      !! ** Purpose :   provide analytical function for the s-coordinate 
     282      !! 
     283      !! ** Method  :   the function provides the non-dimensional position of 
     284      !!                T and W (i.e. between 0 and 1) 
     285      !!                T-points at integer values (between 1 and jpk) 
     286      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5) 
     287      !! 
     288      !!                This method allows the maintenance of fixed surface and or 
     289      !!                bottom cell resolutions (cf. geopotential coordinates)  
     290      !!                within an analytically derived stretched S-coordinate framework. 
     291      !! 
     292      !! Reference  :   Siddorn and Furner, in prep 
     293      !!---------------------------------------------------------------------- 
     294!     USE utils, ONLY : jpk,wp,rn_alpha 
     295      IMPLICIT NONE 
     296      REAL(wp), INTENT(in   ) ::   pk1           ! continuous "k" coordinate 
     297      REAL(wp)                ::   p_gamma       ! stretched coordinate 
     298      REAL(wp), INTENT(in   ) ::   pzb           ! Bottom box depth 
     299      REAL(wp), INTENT(in   ) ::   pzs           ! surface box depth 
     300      REAL(wp), INTENT(in   ) ::   psmth         ! Smoothing parameter 
     301      REAL(wp)                ::   za1,za2,za3   ! local variables 
     302      REAL(wp)                ::   zn1,zn2       ! local variables 
     303      REAL(wp)                ::   za,zb,zx      ! local variables 
     304      !!---------------------------------------------------------------------- 
     305      ! 
     306 
     307      zn1  =  1./(jpk-1.) 
     308      zn2  =  1. -  zn1 
     309 
     310      za1 = (rn_alpha+2.0)*zn1**(rn_alpha+1.0)-(rn_alpha+1.0)*zn1**(rn_alpha+2.0)  
     311      za2 = (rn_alpha+2.0)*zn2**(rn_alpha+1.0)-(rn_alpha+1.0)*zn2**(rn_alpha+2.0) 
     312      za3 = (zn2**3.0 - za2)/( zn1**3.0 - za1) 
     313      
     314      za = pzb - za3*(pzs-za1)-za2 
     315      za = za/( zn2-0.5*(za2+zn2**2.0) - za3*(zn1-0.5*(za1+zn1**2.0) ) ) 
     316      zb = (pzs - za1 - za*( zn1-0.5*(za1+zn1**2.0 ) ) ) / (zn1**3.0 - za1) 
     317      zx = 1.0-za/2.0-zb 
     318 
     319      p_gamma = za*(pk1*(1.0-pk1/2.0))+zb*pk1**3.0 +  & 
     320                  & zx*( (rn_alpha+2.0)*pk1**(rn_alpha+1.0)- & 
     321                  &      (rn_alpha+1.0)*pk1**(rn_alpha+2.0) ) 
     322      p_gamma = p_gamma*psmth+pk1*(1.0-psmth) 
     323 
     324      ! 
     325   END FUNCTION fgamma 
    224326 
    225327 
Note: See TracChangeset for help on using the changeset viewer.