Changeset 5794
- Timestamp:
- 2015-10-14T12:22:34+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN
- Files:
-
- 1 added
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/scoord_gen.F90
r5769 r5794 41 41 !! s_tanh (Madec et al 1996) 42 42 !! a cosh/tanh function that gives stretched coordinates 43 !! 44 !! ** History: 2015: Tim Graham - Code created based on online zdf_sco routine 45 !! 43 46 !! 44 47 !!---------------------------------------------------------------------- … … 201 204 ! Envelope bathymetry saved in hbatt 202 205 hbatt(:,:) = zenv(:,:) 203 ! TODO - get this section to work204 206 IF( ln_eq_taper) THEN 205 207 CALL READ_GPHIT() 206 208 IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0. ) THEN 207 CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' )209 WRITE(*,*) 's-coordinates are tapered in vicinity of the Equator' 208 210 DO jj = 1, jpj 209 211 DO ji = 1, jpi … … 212 214 END DO 213 215 END DO 216 ENDIF 214 217 ENDIF 215 218 ! … … 298 301 ENDIF 299 302 300 CALL check_nf90( nf90_put_var(ncout, var_ids(11), mbathy) ) 303 !Write all 2D variables to output file 304 CALL write_netcdf_2d_vars() 301 305 CALL check_nf90( nf90_close(ncout) ) 302 306 … … 403 407 404 408 z_gsigt3m1 = z_gsigt3 405 z_gsi w3m1 = z_gsiw3409 z_gsi3w3m1 = z_gsi3w3 406 410 407 411 where (e3t_0 (:,:).eq.0.0) e3t_0(:,:) = 1.0 … … 413 417 where (e3vw_0 (:,:).eq.0.0) e3vw_0(:,:) = 1.0 414 418 415 CALL write_netcdf_ vars(jk)419 CALL write_netcdf_3d_vars(jk) 416 420 DO jj = 1, jpj 417 421 DO ji = 1, jpi … … 507 511 IF( jk .EQ. 1) THEN 508 512 z_esigw3(ji,jj ) = 2.0 * (z_gsigt3(ji,jj ) - z_gsigw3(ji,jj )) 509 z_gsi3w3(ji,jj) = 0.5 * z_esigw3(ji,jj) 513 z_gsi3w3(ji,jj) = 0.5 * z_esigw3(ji,jj) 510 514 ELSE 511 515 z_esigw3(ji,jj) = z_gsigt3(ji,jj) - z_gsigt3m1(ji,jj) … … 552 556 ! Keep some arrays for next level 553 557 z_gsigt3m1 = z_gsigt3 554 z_gsi w3m1 = z_gsiw3558 z_gsi3w3m1 = z_gsi3w3 555 559 556 560 where (e3t_0 (:,:).eq.0.0) e3t_0(:,:) = 1.0 … … 562 566 where (e3vw_0 (:,:).eq.0.0) e3vw_0(:,:) = 1.0 563 567 564 CALL write_netcdf_ vars(jk)568 CALL write_netcdf_3d_vars(jk) 565 569 566 570 DO jj = 1, jpj … … 622 626 DO jk = 2, jpk 623 627 z_gsi3w(jk) = z_gsi3w(jk-1) + z_esigw(jk) 624 END DO625 !!gm: depuw, depvw can be suppressed (modif in ldfslp) and depw=dep3w can be set (save 3 3D arrays)626 DO jk = 1, jpk627 628 END DO 628 629 !!gm: e3uw, e3vw can be suppressed (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays) … … 655 656 where (e3vw_0 (:,:).eq.0.0) e3vw_0(:,:) = 1.0 656 657 657 CALL write_netcdf_ vars(jk)658 CALL write_netcdf_3d_vars(jk) 658 659 ENDDO ! End of loop over jk 659 660 -
branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90
r5769 r5794 23 23 !! s-coordinate and hybrid z-s-coordinate 24 24 !! =----------------======--------------- 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gsigt, gsigw !: model level depth coefficient at t-, w-levels (analytic)26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gsi3w !: model level depth coefficient at w-level (sum of gsigw)27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: esigt, esigw !: vertical scale factor coef. at t-, w-levels28 29 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hbatv , hbatf !: ocean depth at the vertical of v--f 30 26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hbatt , hbatu !: t--u points (m) … … 60 56 61 57 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, &63 rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b58 & cn_coord_hgr, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & 59 & rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b 64 60 65 61 ! IDs for output netcdf file 66 62 INTEGER :: id_x, id_y, id_z 67 63 INTEGER :: ncout 68 INTEGER, DIMENSION( 11) :: var_ids !Array to contain all variable IDs64 INTEGER, DIMENSION(20) :: var_ids !Array to contain all variable IDs 69 65 70 66 CONTAINS … … 81 77 ALLOCATE( gdep3w_0(jpi,jpj) , e3v_0(jpi,jpj) , e3f_0(jpi,jpj) , & 82 78 & gdept_0(jpi,jpj) , e3t_0(jpi,jpj) , e3u_0 (jpi,jpj) , & 83 & gdepw_0(jpi,jpj) , e3w_0(jpi,jpj) , e3vw_0(jpi,jpj) , 79 & gdepw_0(jpi,jpj) , e3w_0(jpi,jpj) , e3vw_0(jpi,jpj) , & 84 80 & gphit(jpi,jpj) , e3uw_0(jpi,jpj) , STAT=ierr(2) ) 85 81 ! … … 130 126 CALL check_nf90( nf90_close(ncin), 'Error closing horizontal coordinate file' ) 131 127 132 END SUBROUTINE read_gphit ()128 END SUBROUTINE read_gphit 133 129 134 130 SUBROUTINE dimlen( ncid, dimname, len ) … … 172 168 CALL check_nf90( nf90_def_var(ncout, 'e3uw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(9)) ) 173 169 CALL check_nf90( nf90_def_var(ncout, 'e3vw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(10)) ) 170 ! 2D fields 174 171 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)) ) 172 CALL check_nf90( nf90_def_var(ncout, 'hbatt', nf90_double, (/id_x, id_y/), var_ids(12)) ) 173 CALL check_nf90( nf90_def_var(ncout, 'hbatu', nf90_double, (/id_x, id_y/), var_ids(13)) ) 174 CALL check_nf90( nf90_def_var(ncout, 'hbatv', nf90_double, (/id_x, id_y/), var_ids(14)) ) 175 CALL check_nf90( nf90_def_var(ncout, 'hbatf', nf90_double, (/id_x, id_y/), var_ids(15)) ) 184 176 185 177 … … 191 183 END SUBROUTINE make_coord_file 192 184 193 SUBROUTINE write_netcdf_vars(kk) 185 SUBROUTINE write_netcdf_2d_vars() 186 187 CALL check_nf90( nf90_put_var(ncout, var_ids(11), mbathy, (/ 1,1 /), (/ jpi, jpj /) ) ) 188 CALL check_nf90( nf90_put_var(ncout, var_ids(12), hbatt, (/ 1,1 /), (/ jpi, jpj /) ) ) 189 CALL check_nf90( nf90_put_var(ncout, var_ids(13), hbatu, (/ 1,1 /), (/ jpi, jpj /) ) ) 190 CALL check_nf90( nf90_put_var(ncout, var_ids(14), hbatv, (/ 1,1 /), (/ jpi, jpj /) ) ) 191 CALL check_nf90( nf90_put_var(ncout, var_ids(15), hbatf, (/ 1,1 /), (/ jpi, jpj /) ) ) 192 193 END SUBROUTINE write_netcdf_2d_vars 194 195 SUBROUTINE write_netcdf_3d_vars(kk) 194 196 ! Write variables to the netcdf file at level kk 195 197 INTEGER, INTENT(in) :: kk … … 205 207 CALL check_nf90( nf90_put_var(ncout, var_ids(9), e3uw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 206 208 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 /) ) ) 216 217 END SUBROUTINE write_netcdf_vars 209 210 END SUBROUTINE write_netcdf_3d_vars 218 211 219 212 SUBROUTINE check_nf90( istat, message )
Note: See TracChangeset
for help on using the changeset viewer.