New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 4739 for branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/coast_dist.F90 – NEMO

Ignore:
Timestamp:
2014-08-13T10:46:04+02:00 (10 years ago)
Author:
timgraham
Message:

Updated C1D/dyndmp.F90 and trcdmp.F90 to read restoration coefficient from a file.
Modified namelist_top_ref to match new options
Bug fixes to DMP_TOOLS tool and addition of custom.F90 to allow users to make modifications. Also changed to use working precision (wp) throughout.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/coast_dist.F90

    r4738 r4739  
    1919      !! 
    2020      IMPLICIT NONE 
    21       REAL(8), DIMENSION(jpi,jpj), INTENT( inout ) :: presto 
    22       REAL(8), DIMENSION(jpi,jpj) :: zdct 
    23       REAL(8) :: zinfl = 1000.e3  ! Distance of influence of coast line (could be 
     21      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: presto 
     22      REAL(wp), DIMENSION(jpi,jpj) :: zdct 
     23      REAL(wp) :: zinfl = 1000.e3_wp  ! Distance of influence of coast line (could be 
    2424                                  ! a namelist setting) 
    2525      INTEGER :: jj, ji           ! dummy loop indices 
     
    3030         DO ji = 1, jpi 
    3131            zdct(ji,jj) = MIN( zinfl, zdct(ji,jj) ) 
    32             presto(ji,jj) = presto(ji, jj) * 0.5 * (  1. - COS( rpi*zdct(ji,jj)/zinfl) ) 
     32            presto(ji,jj) = presto(ji, jj) * 0.5_wp * (  1._wp - COS( rpi*zdct(ji,jj)/zinfl) ) 
    3333         END DO 
    3434      END DO 
     
    5757      !!---------------------------------------------------------------------- 
    5858      !! 
    59       REAL(8), DIMENSION(jpi,jpj), INTENT( out ) ::   pdct   ! distance to the coastline 
     59      REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::   pdct   ! distance to the coastline 
    6060      !! 
    6161      INTEGER ::   ji, jj, jl   ! dummy loop indices 
    6262      INTEGER ::   iju, ijt, icoast, itime, ierr, icot   ! local integers 
    6363      CHARACTER (len=32) ::   clname                     ! local name 
    64       REAL(8) ::   zdate0                               ! local scalar 
    65       REAL(8), POINTER, DIMENSION(:,:) ::  zxt, zyt, zzt, zmask 
    66       REAL(8), POINTER, DIMENSION(:  ) ::  zxc, zyc, zzc, zdis    ! temporary workspace 
     64      REAL(wp) ::   zdate0                               ! local scalar 
     65      REAL(wp), POINTER, DIMENSION(:,:) ::  zxt, zyt, zzt, zmask 
     66      REAL(wp), POINTER, DIMENSION(:  ) ::  zxc, zyc, zzc, zdis    ! temporary workspace 
    6767      LOGICAL , ALLOCATABLE, DIMENSION(:,:) ::  llcotu, llcotv, llcotf   ! 2D logical workspace 
    6868 
     
    9090      CALL check_nf90( nf90_get_var( ncin, fmask_id, fmask, (/ 1,1 /), (/ jpi, jpj /) ) ) 
    9191 
    92       pdct(:,:) = 0. 
     92      pdct(:,:) = 0._wp 
    9393      zxt(:,:) = COS( rad * gphit(:,:) ) * COS( rad * glamt(:,:) ) 
    9494      zyt(:,:) = COS( rad * gphit(:,:) ) * SIN( rad * glamt(:,:) ) 
     
    101101               zmask(ji,jj) =  ( tmask(ji,jj+1) + tmask(ji+1,jj+1) & 
    102102                   &           + tmask(ji,jj  ) + tmask(ji+1,jj  ) ) 
    103                llcotu(ji,jj) = ( tmask(ji,jj ) + tmask(ji+1,jj  ) == 1. )  
    104                llcotv(ji,jj) = ( tmask(ji,jj  ) + tmask(ji  ,jj+1) == 1. )  
    105                llcotf(ji,jj) = ( zmask(ji,jj) > 0. ) .AND. ( zmask(ji,jj) < 4. ) 
     103               llcotu(ji,jj) = ( tmask(ji,jj ) + tmask(ji+1,jj  ) == 1._wp )  
     104               llcotv(ji,jj) = ( tmask(ji,jj  ) + tmask(ji  ,jj+1) == 1._wp )  
     105               llcotf(ji,jj) = ( zmask(ji,jj) > 0._wp ) .AND. ( zmask(ji,jj) < 4._wp ) 
    106106            END DO 
    107107         END DO 
     
    196196         DO jj = 1, jpj 
    197197            DO ji = 1, jpi 
    198                IF( tmask(ji,jj) == 0. ) THEN 
    199                   pdct(ji,jj) = 0. 
     198               IF( tmask(ji,jj) == 0._wp ) THEN 
     199                  pdct(ji,jj) = 0._wp 
    200200               ELSE 
    201201                  DO jl = 1, icoast 
Note: See TracChangeset for help on using the changeset viewer.