Changeset 1590
- Timestamp:
- 2009-08-06T12:18:30+02:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DOM/domwri.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DOM/domwri.F90
r1161 r1590 21 21 PRIVATE 22 22 23 !! * Accessibility24 23 PUBLIC dom_wri ! routine called by inidom.F90 24 25 !! * Substitutions 26 # include "vectopt_loop_substitute.h90" 25 27 !!---------------------------------------------------------------------- 26 28 !! OPA 9.0 , LOCEAN-IPSL (2005) … … 59 61 !! 9.0 ! 02-08 (G. Madec) F90 and several file 60 62 !!---------------------------------------------------------------------- 61 INTEGER :: inum0 ! temprary units for 'mesh_mask.nc' file 62 INTEGER :: inum1 ! temprary units for 'mesh.nc' file 63 INTEGER :: inum2 ! temprary units for 'mask.nc' file 64 INTEGER :: inum3 ! temprary units for 'mesh_hgr.nc' file 65 INTEGER :: inum4 ! temprary units for 'mesh_zgr.nc' file 66 REAL(wp), DIMENSION(jpi,jpj) :: zprt ! temporary array for bathymetry 67 CHARACTER (len=21) :: clnam0 ! filename (mesh and mask informations) 68 CHARACTER (len=21) :: clnam1 ! filename (mesh informations) 69 CHARACTER (len=21) :: clnam2 ! filename (mask informations) 70 CHARACTER (len=21) :: clnam3 ! filename (horizontal mesh informations) 71 CHARACTER (len=21) :: clnam4 ! filename (vertical mesh informations) 72 !!---------------------------------------------------------------------- 73 74 IF(lwp) WRITE(numout,*) 75 IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)' 76 IF(lwp) WRITE(numout,*) '~~~~~~~' 77 78 clnam0 = 'mesh_mask' ! filename (mesh and mask informations) 79 clnam1 = 'mesh' ! filename (mesh informations) 80 clnam2 = 'mask' ! filename (mask informations) 81 clnam3 = 'mesh_hgr' ! filename (horizontal mesh informations) 82 clnam4 = 'mesh_zgr' ! filename (vertical mesh informations) 83 84 SELECT CASE (nmsh) 63 INTEGER :: inum0 ! temprary units for 'mesh_mask.nc' file 64 INTEGER :: inum1 ! temprary units for 'mesh.nc' file 65 INTEGER :: inum2 ! temprary units for 'mask.nc' file 66 INTEGER :: inum3 ! temprary units for 'mesh_hgr.nc' file 67 INTEGER :: inum4 ! temprary units for 'mesh_zgr.nc' file 68 INTEGER :: ji, jj, jk, ik 69 REAL(wp), DIMENSION(jpi,jpj) :: zprt ! temporary array for bathymetry 70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepu ! 3D depth of U point 71 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepv ! 3D depth of V point 72 CHARACTER(len=21) :: clnam0 ! filename (mesh and mask informations) 73 CHARACTER(len=21) :: clnam1 ! filename (mesh informations) 74 CHARACTER(len=21) :: clnam2 ! filename (mask informations) 75 CHARACTER(len=21) :: clnam3 ! filename (horizontal mesh informations) 76 CHARACTER(len=21) :: clnam4 ! filename (vertical mesh informations) 77 !!---------------------------------------------------------------------- 78 79 IF(lwp) WRITE(numout,*) 80 IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)' 81 IF(lwp) WRITE(numout,*) '~~~~~~~' 82 83 clnam0 = 'mesh_mask' ! filename (mesh and mask informations) 84 clnam1 = 'mesh' ! filename (mesh informations) 85 clnam2 = 'mask' ! filename (mask informations) 86 clnam3 = 'mesh_hgr' ! filename (horizontal mesh informations) 87 clnam4 = 'mesh_zgr' ! filename (vertical mesh informations) 88 89 SELECT CASE ( MOD(nmsh, 3) ) 85 90 ! ! ============================ 86 91 CASE ( 1 ) ! create 'mesh_mask.nc' file … … 100 105 inum4 = inum1 ! in unit inum1 101 106 ! ! ============================ 102 CASE ( 3) ! create 'mesh_hgr.nc'107 CASE ( 0 ) ! create 'mesh_hgr.nc' 103 108 ! ! 'mesh_zgr.nc' and 104 109 ! ! 'mask.nc' files … … 180 185 181 186 IF( ln_zps ) THEN ! z-coordinate - partial steps 182 CALL iom_rstput( 0, 0, inum4, 'hdept' , hdept ) ! ! bottom depth 183 CALL iom_rstput( 0, 0, inum4, 'hdepw' , hdepw ) 184 185 CALL iom_rstput( 0, 0, inum4, 'e3t_ps', e3tp ) ! ! bottom scale factors 186 CALL iom_rstput( 0, 0, inum4, 'e3w_ps', e3wp ) 187 187 188 IF( nmsh <= 6 ) THEN ! ! 3D vertical scale factors 189 CALL iom_rstput( 0, 0, inum4, 'e3t', e3t ) 190 CALL iom_rstput( 0, 0, inum4, 'e3u', e3u ) 191 CALL iom_rstput( 0, 0, inum4, 'e3v', e3v ) 192 CALL iom_rstput( 0, 0, inum4, 'e3w', e3w ) 193 ELSE ! ! 2D bottom scale factors 194 DO jj = 1,jpj ; DO ji = 1,jpi 195 ik = NINT( zprt(ji,jj) ) ! take care that mbathy is not what you think it is here ! 196 IF ( ik /= 0 ) THEN ; e3tp(ji,jj) = e3t(ji,jj,ik) ; e3wp(ji,jj) = e3w(ji,jj,ik) 197 ELSE ; e3tp(ji,jj) = 0. ; e3wp(ji,jj) = 0. 198 ENDIF 199 END DO ; END DO 200 CALL iom_rstput( 0, 0, inum4, 'e3t_ps', e3tp ) 201 CALL iom_rstput( 0, 0, inum4, 'e3w_ps', e3wp ) 202 END IF 203 204 IF( nmsh <= 3 ) THEN ! ! 3D depth 205 CALL iom_rstput( 0, 0, inum4, 'gdept', gdept, ktype = jp_r4 ) 206 DO jk = 1,jpk ; DO jj = 1, jpjm1 ; DO ji = 1, fs_jpim1 ! vector opt. 207 zdepu(ji,jj,jk) = MIN( gdept(ji,jj,jk), gdept(ji+1,jj ,jk) ) 208 zdepv(ji,jj,jk) = MIN( gdept(ji,jj,jk), gdept(ji ,jj+1,jk) ) 209 END DO ; END DO ; END DO 210 CALL lbc_lnk( zdepu, 'U', 1. ) ; CALL lbc_lnk( zdepv, 'V', 1. ) 211 CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r4 ) 212 CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r4 ) 213 CALL iom_rstput( 0, 0, inum4, 'gdepw', gdepw, ktype = jp_r4 ) 214 ELSE ! ! 2D bottom depth 215 DO jj = 1,jpj ; DO ji = 1,jpi 216 ik = NINT( zprt(ji,jj) ) ! take care that mbathy is not what you think it is here ! 217 IF ( ik /= 0 ) THEN ; hdept(ji,jj) = gdept(ji,jj,ik) ; hdepw(ji,jj) = gdepw(ji,jj,ik+1) 218 ELSE ; hdept(ji,jj) = 0. ; hdepw(ji,jj) = 0. 219 ENDIF 220 END DO ; END DO 221 CALL iom_rstput( 0, 0, inum4, 'hdept' , hdept, ktype = jp_r4 ) 222 CALL iom_rstput( 0, 0, inum4, 'hdepw' , hdepw, ktype = jp_r4 ) 223 ENDIF 224 188 225 CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 ) ! ! reference z-coord. 189 226 CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 )
Note: See TracChangeset
for help on using the changeset viewer.
