Changeset 5769
- Timestamp:
- 2015-10-01T10:24:30+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src
- Files:
-
- 2 edited
-
scoord_gen.F90 (modified) (4 diffs)
-
utils.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/scoord_gen.F90
r5295 r5769 57 57 58 58 WRITE(*,*) 59 WRITE(*,*) ' domzgr_sco: s-coordinate or hybrid z-s-coordinate'59 WRITE(*,*) 'scoord_gen : s-coordinate or hybrid z-s-coordinate' 60 60 WRITE(*,*) '~~~~~~~~~~~' 61 61 WRITE(*,*) ' Namelist namzgr_sco' … … 66 66 WRITE(*,*) ' Critical depth rn_hc = ',rn_hc 67 67 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 68 70 WRITE(*,*) ' Song and Haidvogel 1994 stretching ln_s_sh94 = ',ln_s_sh94 69 71 WRITE(*,*) ' Song and Haidvogel 1994 stretching coefficients' … … 126 128 END DO 127 129 END DO 128 WRITE(*,*) 'domzgr_sco print', bathy(196,147)129 130 ! 130 131 ! smooth the bathymetry (if required) … … 199 200 ! 200 201 ! Envelope bathymetry saved in hbatt 202 hbatt(:,:) = zenv(:,:) 201 203 ! 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 212 215 ! 213 216 ! ! ============================== -
branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90
r5269 r5769 15 15 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gdep3w_0 !: depth of t-points (sum of e3w) (m) 16 16 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 17 18 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3v_0 , e3f_0 !: analytical (time invariant) vertical scale factors at v-f 18 19 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3t_0 , e3u_0 !: t-u points (m) … … 55 56 REAL(wp) :: rn_jpk, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax, rn_theta 56 57 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, & 60 63 rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b 61 64 … … 78 81 ALLOCATE( gdep3w_0(jpi,jpj) , e3v_0(jpi,jpj) , e3f_0(jpi,jpj) , & 79 82 & 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) ) 82 85 ! 83 86 ! … … 93 96 ! 94 97 END FUNCTION dom_oce_alloc 95 98 96 99 97 100 SUBROUTINE read_bathy() … … 114 117 115 118 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() 116 133 117 134 SUBROUTINE dimlen( ncid, dimname, len ) … … 143 160 CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) ) 144 161 ! 145 !Define variables 162 !Define variables - include all varibles that would be put into the mesh 163 !mask file 146 164 CALL check_nf90( nf90_def_var(ncout, 'gdept_0', nf90_double, (/id_x, id_y,id_z/), var_ids(1)) ) 147 165 CALL check_nf90( nf90_def_var(ncout, 'gdepw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(2)) ) … … 155 173 CALL check_nf90( nf90_def_var(ncout, 'e3vw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(10)) ) 156 174 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 157 185 158 186 ! End define mode … … 177 205 CALL check_nf90( nf90_put_var(ncout, var_ids(9), e3uw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 178 206 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 /) ) ) 179 216 180 217 END SUBROUTINE write_netcdf_vars
Note: See TracChangeset
for help on using the changeset viewer.
