Changeset 5769


Ignore:
Timestamp:
2015-10-01T10:24:30+02:00 (5 years ago)
Author:
timgraham
Message:

1) Added tapering near equator if domain crosses equator
2) Added all variables that are needed for mesh_mask file to the output file.

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

    r5295 r5769  
    5757 
    5858      WRITE(*,*) 
    59       WRITE(*,*) 'domzgr_sco : s-coordinate or hybrid z-s-coordinate' 
     59      WRITE(*,*) 'scoord_gen : s-coordinate or hybrid z-s-coordinate' 
    6060      WRITE(*,*) '~~~~~~~~~~~' 
    6161      WRITE(*,*) '   Namelist namzgr_sco' 
     
    6666      WRITE(*,*) '        Critical depth                               rn_hc         = ',rn_hc 
    6767      WRITE(*,*) '        maximum cut-off r-value allowed              rn_rmax       = ',rn_rmax 
     68      WRITE(*,*) '        Tapering in vicinity of equator              ln_eq_taper   = ',ln_eq_taper 
     69      WRITE(*,*) '        Horizontal Coordinate File                   cn_coord_hgr  = ',cn_coord_hgr 
    6870      WRITE(*,*) '     Song and Haidvogel 1994 stretching              ln_s_sh94     = ',ln_s_sh94 
    6971      WRITE(*,*) '        Song and Haidvogel 1994 stretching coefficients' 
     
    126128         END DO 
    127129      END DO 
    128       WRITE(*,*) 'domzgr_sco print', bathy(196,147) 
    129130      !  
    130131      ! smooth the bathymetry (if required) 
     
    199200      ! 
    200201      ! Envelope bathymetry saved in hbatt 
     202      hbatt(:,:) = zenv(:,:)  
    201203      ! TODO - get this section to work 
    202       hbatt(:,:) = zenv(:,:)  
    203 !      IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0. ) THEN 
    204  !        CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' ) 
    205  !        DO jj = 1, jpj 
    206  !           DO ji = 1, jpi 
    207  !              ztaper = EXP( -(gphit(ji,jj)/8.)**2. ) 
    208  !              hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1. - ztaper ) 
    209  !           END DO 
    210  !        END DO 
    211  !     ENDIF 
     204      IF( ln_eq_taper) THEN 
     205        CALL READ_GPHIT() 
     206        IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0. ) THEN 
     207          CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' ) 
     208          DO jj = 1, jpj 
     209             DO ji = 1, jpi 
     210                ztaper = EXP( -(gphit(ji,jj)/8.)**2. ) 
     211                hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1. - ztaper ) 
     212             END DO 
     213          END DO 
     214      ENDIF 
    212215      ! 
    213216      !                                        ! ============================== 
  • branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90

    r5269 r5769  
    1515   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gdep3w_0           !: depth of t-points (sum of e3w) (m) 
    1616   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gdept_0, gdepw_0   !: analytical (time invariant) depth at t-w  points (m) 
     17   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gphit              !: latitude at t points 
    1718   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3v_0  , e3f_0     !: analytical (time invariant) vertical scale factors at  v-f 
    1819   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_0  , e3u_0     !:                                      t-u  points (m) 
     
    5556   REAL(wp) :: rn_jpk, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax, rn_theta 
    5657   REAL(wp) :: rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b 
    57    LOGICAL :: ln_s_sh94, ln_s_sf12, ln_sigcrit 
    58  
    59    NAMELIST/namzgr_sco/rn_jpk, ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & 
     58   LOGICAL :: ln_s_sh94, ln_s_sf12, ln_sigcrit, ln_eq_taper 
     59   CHARACTER(len=50) :: cn_coord_hgr 
     60 
     61   NAMELIST/namzgr_sco/rn_jpk, ln_s_sh94, ln_s_sf12, ln_sigcrit, ln_eq_taper, &  
     62                        cn_coord_hgr, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & 
    6063                        rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b 
    6164 
     
    7881      ALLOCATE( gdep3w_0(jpi,jpj) , e3v_0(jpi,jpj) , e3f_0(jpi,jpj) ,                         & 
    7982         &      gdept_0(jpi,jpj) , e3t_0(jpi,jpj) , e3u_0 (jpi,jpj) ,                         & 
    80          &      gdepw_0(jpi,jpj) , e3w_0(jpi,jpj) , e3vw_0(jpi,jpj) , e3uw_0(jpi,jpj) , STAT=ierr(2) ) 
    81          ! 
     83         &      gdepw_0(jpi,jpj) , e3w_0(jpi,jpj) , e3vw_0(jpi,jpj) ,  
     84         &      gphit(jpi,jpj)   , e3uw_0(jpi,jpj) , STAT=ierr(2) ) 
    8285         ! 
    8386         ! 
     
    9396      ! 
    9497   END FUNCTION dom_oce_alloc 
    95     
     98  
    9699 
    97100   SUBROUTINE read_bathy() 
     
    114117 
    115118   END SUBROUTINE read_bathy 
     119 
     120   SUBROUTINE read_gphit() 
     121   !! Read gphit from horizontal coordinate file if required 
     122     INTEGER :: var_id, ncin 
     123 
     124     CALL check_nf90( nf90_open(cn_coord_hgr, NF90_NOWRITE, ncin), 'Error opening horizontal coordinate file' ) 
     125 
     126     ! Read gphit variable from file 
     127     CALL check_nf90( nf90_inq_varid( ncin, 'gphit', var_id ), 'Cannot get variable ID for bathymetry') 
     128     CALL check_nf90( nf90_get_var( ncin, var_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) ) 
     129 
     130     CALL check_nf90( nf90_close(ncin), 'Error closing horizontal coordinate file' ) 
     131 
     132   END SUBROUTINE read_gphit() 
    116133 
    117134   SUBROUTINE dimlen( ncid, dimname, len ) 
     
    143160     CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) ) 
    144161     ! 
    145      !Define variables 
     162     !Define variables - include all varibles that would be put into the mesh 
     163     !mask file 
    146164     CALL check_nf90( nf90_def_var(ncout, 'gdept_0', nf90_double, (/id_x, id_y,id_z/), var_ids(1)) ) 
    147165     CALL check_nf90( nf90_def_var(ncout, 'gdepw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(2)) ) 
     
    155173     CALL check_nf90( nf90_def_var(ncout, 'e3vw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(10)) ) 
    156174     CALL check_nf90( nf90_def_var(ncout, 'mbathy', nf90_double, (/id_x, id_y/), var_ids(11)) ) 
     175     CALL check_nf90( nf90_def_var(ncout, 'hbatt', nf90_double, (/id_x, id_y,id_z/), var_ids(12)) ) 
     176     CALL check_nf90( nf90_def_var(ncout, 'hbatu', nf90_double, (/id_x, id_y,id_z/), var_ids(13)) ) 
     177     CALL check_nf90( nf90_def_var(ncout, 'hbatv', nf90_double, (/id_x, id_y,id_z/), var_ids(14)) ) 
     178     CALL check_nf90( nf90_def_var(ncout, 'hbatf', nf90_double, (/id_x, id_y,id_z/), var_ids(15)) ) 
     179     CALL check_nf90( nf90_def_var(ncout, 'gsigt', nf90_double, (/id_x, id_y,id_z/), var_ids(16)) ) 
     180     CALL check_nf90( nf90_def_var(ncout, 'gsigw', nf90_double, (/id_x, id_y,id_z/), var_ids(17)) ) 
     181     CALL check_nf90( nf90_def_var(ncout, 'gsi3w', nf90_double, (/id_x, id_y,id_z/), var_ids(18)) ) 
     182     CALL check_nf90( nf90_def_var(ncout, 'esigt', nf90_double, (/id_x, id_y,id_z/), var_ids(19)) ) 
     183     CALL check_nf90( nf90_def_var(ncout, 'esigw', nf90_double, (/id_x, id_y,id_z/), var_ids(20)) ) 
     184 
    157185      
    158186     ! End define mode 
     
    177205     CALL check_nf90( nf90_put_var(ncout, var_ids(9), e3uw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
    178206     CALL check_nf90( nf90_put_var(ncout, var_ids(10), e3vw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     207     CALL check_nf90( nf90_put_var(ncout, var_ids(12), hbatt, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     208     CALL check_nf90( nf90_put_var(ncout, var_ids(13), hbatu, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     209     CALL check_nf90( nf90_put_var(ncout, var_ids(14), hbatv, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     210     CALL check_nf90( nf90_put_var(ncout, var_ids(15), hbatf, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     211     CALL check_nf90( nf90_put_var(ncout, var_ids(16), gsigt, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     212     CALL check_nf90( nf90_put_var(ncout, var_ids(17), gsigw, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     213     CALL check_nf90( nf90_put_var(ncout, var_ids(18), gsi3w, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     214     CALL check_nf90( nf90_put_var(ncout, var_ids(19), esigt, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     215     CALL check_nf90( nf90_put_var(ncout, var_ids(20), esi3w, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
    179216 
    180217   END SUBROUTINE write_netcdf_vars 
Note: See TracChangeset for help on using the changeset viewer.