Changeset 1161
- Timestamp:
- 2008-07-01T13:50:07+02:00 (16 years ago)
- Location:
- trunk/NEMO/OPA_SRC/DOM
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DOM/dom_oce.F90
r1152 r1161 144 144 145 145 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 146 hdept, hdepw, e3tp, e3wp !: ???146 hdept, hdepw, e3tp, e3wp !: bottom depth and thickness at T and W points 147 147 148 148 !! s-coordinate and hybrid z-s-coordinate -
trunk/NEMO/OPA_SRC/DOM/domwri.F90
r1152 r1161 15 15 USE in_out_manager 16 16 USE iom 17 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 18 USE lib_mpp 17 19 18 20 IMPLICIT NONE … … 80 82 clnam4 = 'mesh_zgr' ! filename (vertical mesh informations) 81 83 84 SELECT CASE (nmsh) 85 ! ! ============================ 86 CASE ( 1 ) ! create 'mesh_mask.nc' file 87 ! ! ============================ 88 CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 89 inum2 = inum0 ! put all the informations 90 inum3 = inum0 ! in unit inum0 91 inum4 = inum0 92 93 ! ! ============================ 94 CASE ( 2 ) ! create 'mesh.nc' and 95 ! ! 'mask.nc' files 96 ! ! ============================ 97 CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib ) 98 CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 99 inum3 = inum1 ! put mesh informations 100 inum4 = inum1 ! in unit inum1 101 ! ! ============================ 102 CASE ( 3 ) ! create 'mesh_hgr.nc' 103 ! ! 'mesh_zgr.nc' and 104 ! ! 'mask.nc' files 105 ! ! ============================ 106 CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 107 CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib ) 108 CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib ) 109 110 END SELECT 111 112 ! ! masks (inum2) 113 CALL iom_rstput( 0, 0, inum2, 'tmask', tmask, ktype = jp_i1 ) ! ! land-sea mask 114 CALL iom_rstput( 0, 0, inum2, 'umask', umask, ktype = jp_i1 ) 115 CALL iom_rstput( 0, 0, inum2, 'vmask', vmask, ktype = jp_i1 ) 116 CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 ) 117 118 119 zprt = tmask(:,:,1) * dom_uniq('T') ! ! unique point mask 120 CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 ) 121 zprt = umask(:,:,1) * dom_uniq('U') 122 CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 ) 123 zprt = vmask(:,:,1) * dom_uniq('V') 124 CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 ) 125 zprt = fmask(:,:,1) * dom_uniq('F') 126 CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 ) 127 128 ! ! horizontal mesh (inum3) 129 CALL iom_rstput( 0, 0, inum3, 'glamt', glamt, ktype = jp_r4 ) ! ! latitude 130 CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r4 ) 131 CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r4 ) 132 CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r4 ) 133 134 CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r4 ) ! ! longitude 135 CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r4 ) 136 CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r4 ) 137 CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r4 ) 138 139 CALL iom_rstput( 0, 0, inum3, 'e1t', e1t, ktype = jp_r8 ) ! ! e1 scale factors 140 CALL iom_rstput( 0, 0, inum3, 'e1u', e1u, ktype = jp_r8 ) 141 CALL iom_rstput( 0, 0, inum3, 'e1v', e1v, ktype = jp_r8 ) 142 CALL iom_rstput( 0, 0, inum3, 'e1f', e1f, ktype = jp_r8 ) 143 144 CALL iom_rstput( 0, 0, inum3, 'e2t', e2t, ktype = jp_r8 ) ! ! e2 scale factors 145 CALL iom_rstput( 0, 0, inum3, 'e2u', e2u, ktype = jp_r8 ) 146 CALL iom_rstput( 0, 0, inum3, 'e2v', e2v, ktype = jp_r8 ) 147 CALL iom_rstput( 0, 0, inum3, 'e2f', e2f, ktype = jp_r8 ) 148 149 CALL iom_rstput( 0, 0, inum3, 'ff', ff, ktype = jp_r8 ) ! ! coriolis factor 150 82 151 ! note that mbathy has been modified in dommsk or in solver. 83 152 ! it is the number of non-zero "w" levels in the water, and the minimum … … 86 155 ! 87 156 zprt = tmask(:,:,1)*(mbathy-1) 88 89 SELECT CASE (nmsh) 90 ! ! ============================ 91 CASE ( 1 ) ! create 'mesh_mask.nc' file 92 ! ! ============================ 93 CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 94 inum2 = inum0 ! put all the informations 95 inum3 = inum0 ! in unit inum0 96 inum4 = inum0 97 98 ! ! ============================ 99 CASE ( 2 ) ! create 'mesh.nc' and 100 ! ! 'mask.nc' files 101 ! ! ============================ 102 CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib ) 103 CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 104 inum3 = inum1 ! put mesh informations 105 inum4 = inum1 ! in unit inum1 106 ! ! ============================ 107 CASE ( 3 ) ! create 'mesh_hgr.nc' 108 ! ! 'mesh_zgr.nc' and 109 ! ! 'mask.nc' files 110 ! ! ============================ 111 CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 112 CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib ) 113 CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib ) 114 115 END SELECT 116 117 ! ! masks (inum2) 118 CALL iom_rstput( 0, 0, inum2, 'tmask', tmask, ktype = jp_i1 ) 119 CALL iom_rstput( 0, 0, inum2, 'umask', umask, ktype = jp_i1 ) 120 CALL iom_rstput( 0, 0, inum2, 'vmask', vmask, ktype = jp_i1 ) 121 CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 ) 122 123 ! ! horizontal mesh (inum3) 124 CALL iom_rstput( 0, 0, inum3, 'glamt', glamt, ktype = jp_r4 ) ! ! latitude 125 CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r4 ) 126 CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r4 ) 127 CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r4 ) 128 129 CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r4 ) ! ! longitude 130 CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r4 ) 131 CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r4 ) 132 CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r4 ) 133 134 CALL iom_rstput( 0, 0, inum3, 'e1t', e1t, ktype = jp_r8 ) ! ! e1 scale factors 135 CALL iom_rstput( 0, 0, inum3, 'e1u', e1u, ktype = jp_r8 ) 136 CALL iom_rstput( 0, 0, inum3, 'e1v', e1v, ktype = jp_r8 ) 137 CALL iom_rstput( 0, 0, inum3, 'e1f', e1f, ktype = jp_r8 ) 138 139 CALL iom_rstput( 0, 0, inum3, 'e2t', e2t, ktype = jp_r8 ) ! ! e2 scale factors 140 CALL iom_rstput( 0, 0, inum3, 'e2u', e2u, ktype = jp_r8 ) 141 CALL iom_rstput( 0, 0, inum3, 'e2v', e2v, ktype = jp_r8 ) 142 CALL iom_rstput( 0, 0, inum3, 'e2f', e2f, ktype = jp_r8 ) 143 144 CALL iom_rstput( 0, 0, inum3, 'ff', ff, ktype = jp_r8 ) ! ! coriolis factor 145 146 CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 ) 147 157 CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 ) 158 148 159 #if ! defined key_zco 149 IF( ln_sco ) THEN ! s-coordinate 150 CALL iom_rstput( 0, 0, inum4, 'hbatt', hbatt ) ! ! depth 151 CALL iom_rstput( 0, 0, inum4, 'hbatu', hbatu ) 152 CALL iom_rstput( 0, 0, inum4, 'hbatv', hbatv ) 153 CALL iom_rstput( 0, 0, inum4, 'hbatf', hbatf ) 160 IF( ln_sco ) THEN ! s-coordinate 161 CALL iom_rstput( 0, 0, inum4, 'hbatt', hbatt ) ! ! depth 162 CALL iom_rstput( 0, 0, inum4, 'hbatu', hbatu ) 163 CALL iom_rstput( 0, 0, inum4, 'hbatv', hbatv ) 164 CALL iom_rstput( 0, 0, inum4, 'hbatf', hbatf ) 165 166 CALL iom_rstput( 0, 0, inum4, 'gsigt', gsigt ) ! ! scaling coef. 167 CALL iom_rstput( 0, 0, inum4, 'gsigw', gsigw ) 168 CALL iom_rstput( 0, 0, inum4, 'gsi3w', gsi3w ) 169 CALL iom_rstput( 0, 0, inum4, 'esigt', esigt ) 170 CALL iom_rstput( 0, 0, inum4, 'esigw', esigw ) 171 172 CALL iom_rstput( 0, 0, inum4, 'e3t', e3t ) ! ! scale factors 173 CALL iom_rstput( 0, 0, inum4, 'e3u', e3u ) 174 CALL iom_rstput( 0, 0, inum4, 'e3v', e3v ) 175 CALL iom_rstput( 0, 0, inum4, 'e3w', e3w ) 176 177 CALL iom_rstput( 0, 0, inum4, 'gdept_0' , gdept_0 ) ! ! stretched system 178 CALL iom_rstput( 0, 0, inum4, 'gdepw_0' , gdepw_0 ) 179 ENDIF 180 181 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 188 CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 ) ! ! reference z-coord. 189 CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 ) 190 CALL iom_rstput( 0, 0, inum4, 'e3t_0' , e3t_0 ) 191 CALL iom_rstput( 0, 0, inum4, 'e3w_0' , e3w_0 ) 192 ENDIF 193 194 #endif 195 196 IF( ln_zco ) THEN 197 ! ! z-coordinate - full steps 198 CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 ) ! ! depth 199 CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 ) 200 CALL iom_rstput( 0, 0, inum4, 'e3t_0' , e3t_0 ) ! ! scale factors 201 CALL iom_rstput( 0, 0, inum4, 'e3w_0' , e3w_0 ) 202 ENDIF 203 ! ! ============================ 204 ! ! close the files 205 ! ! ============================ 206 SELECT CASE ( nmsh ) 207 CASE ( 1 ) 208 CALL iom_close( inum0 ) 209 CASE ( 2 ) 210 CALL iom_close( inum1 ) 211 CALL iom_close( inum2 ) 212 CASE ( 3 ) 213 CALL iom_close( inum2 ) 214 CALL iom_close( inum3 ) 215 CALL iom_close( inum4 ) 216 END SELECT 217 218 END SUBROUTINE dom_wri 219 220 221 FUNCTION dom_uniq( cdgrd ) RESULT( puniq ) 222 !!---------------------------------------------------------------------- 223 !! *** ROUTINE dom_uniq *** 224 !! 225 !! ** Purpose : identify unique point of a grid (TUVF) 226 !! 227 !! ** Method : 1) aplly lbc_lnk on an array with different values for each element 228 !! 2) check which elements have been changed 229 !! 230 !!---------------------------------------------------------------------- 231 CHARACTER(len=1) , INTENT(in ) :: cdgrd ! 232 REAL(wp), DIMENSION(jpi,jpj) :: puniq ! 233 234 REAL(wp), DIMENSION(jpi,jpj ) :: ztstref ! array with different values for each element 235 REAL(wp) :: zshift ! shift value link to the process number 236 LOGICAL , DIMENSION(jpi,jpj,1) :: lldbl ! is the point unique or not? 237 INTEGER :: ji ! dummy loop indices 238 !!---------------------------------------------------------------------- 239 240 ! build an array with different values for each element 241 ! in mpp: make sure that these values are different even between process 242 ! -> apply a shift value according to the process number 243 zshift = jpi * jpj * ( narea - 1 ) 244 ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji, wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) ) 154 245 155 CALL iom_rstput( 0, 0, inum4, 'gsigt', gsigt ) ! ! scaling coef. 156 CALL iom_rstput( 0, 0, inum4, 'gsigw', gsigw ) 157 CALL iom_rstput( 0, 0, inum4, 'gsi3w', gsi3w ) 158 CALL iom_rstput( 0, 0, inum4, 'esigt', esigt ) 159 CALL iom_rstput( 0, 0, inum4, 'esigw', esigw ) 160 161 CALL iom_rstput( 0, 0, inum4, 'e3t', e3t ) ! ! scale factors 162 CALL iom_rstput( 0, 0, inum4, 'e3u', e3u ) 163 CALL iom_rstput( 0, 0, inum4, 'e3v', e3v ) 164 CALL iom_rstput( 0, 0, inum4, 'e3w', e3w ) 165 166 CALL iom_rstput( 0, 0, inum4, 'gdept_0' , gdept_0 ) ! ! stretched system 167 CALL iom_rstput( 0, 0, inum4, 'gdepw_0' , gdepw_0 ) 168 ENDIF 169 170 IF( ln_zps ) THEN ! z-coordinate - partial steps 171 CALL iom_rstput( 0, 0, inum4, 'hdept' , hdept ) ! ! depth 172 CALL iom_rstput( 0, 0, inum4, 'hdepw' , hdepw ) 173 174 CALL iom_rstput( 0, 0, inum4, 'e3t' , e3t ) ! ! scale factors 175 CALL iom_rstput( 0, 0, inum4, 'e3u' , e3u ) 176 CALL iom_rstput( 0, 0, inum4, 'e3v' , e3v ) 177 CALL iom_rstput( 0, 0, inum4, 'e3w' , e3w ) 178 179 CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 ) ! ! reference z-coord. 180 CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 ) 181 CALL iom_rstput( 0, 0, inum4, 'e3t_0' , e3t_0 ) 182 CALL iom_rstput( 0, 0, inum4, 'e3w_0' , e3w_0 ) 183 ENDIF 184 185 #endif 186 187 IF( ln_zco ) THEN 188 ! ! z-coordinate - full steps 189 CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 ) ! ! depth 190 CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 ) 191 CALL iom_rstput( 0, 0, inum4, 'e3t_0' , e3t_0 ) ! ! scale factors 192 CALL iom_rstput( 0, 0, inum4, 'e3w_0' , e3w_0 ) 193 ENDIF 194 ! ! ============================ 195 ! ! close the files 196 ! ! ============================ 197 SELECT CASE ( nmsh ) 198 CASE ( 1 ) 199 CALL iom_close( inum0 ) 200 CASE ( 2 ) 201 CALL iom_close( inum1 ) 202 CALL iom_close( inum2 ) 203 CASE ( 3 ) 204 CALL iom_close( inum2 ) 205 CALL iom_close( inum3 ) 206 CALL iom_close( inum4 ) 207 END SELECT 208 209 END SUBROUTINE dom_wri 246 puniq(:,:) = ztstref(:,:) ! default definition 247 CALL lbc_lnk( puniq, cdgrd, 1. ) ! apply boundary conditions 248 lldbl(:,:,1) = puniq(:,:) == ztstref(:,:) ! check which values have been changed 249 250 puniq(:,:) = 1. ! default definition 251 ! fill only the inner part of the cpu with llbl converted into real 252 puniq(nldi:nlei,nldj:nlej) = REAL(COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ), wp) 253 254 END FUNCTION dom_uniq 255 210 256 211 257 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.