| 1 | MODULE domrea |
|---|
| 2 | !!====================================================================== |
|---|
| 3 | !! *** MODULE domrea *** |
|---|
| 4 | !! Ocean initialization : read the ocean domain meshmask file(s) |
|---|
| 5 | !!====================================================================== |
|---|
| 6 | |
|---|
| 7 | !!---------------------------------------------------------------------- |
|---|
| 8 | !! dom_rea : read mesh and mask file(s) |
|---|
| 9 | !! nmsh = 1 : mesh_mask file |
|---|
| 10 | !! = 2 : mesh and mask file |
|---|
| 11 | !! = 3 : mesh_hgr, mesh_zgr and mask |
|---|
| 12 | !!---------------------------------------------------------------------- |
|---|
| 13 | !! * Modules used |
|---|
| 14 | USE dom_oce ! ocean space and time domain |
|---|
| 15 | USE in_out_manager |
|---|
| 16 | |
|---|
| 17 | IMPLICIT NONE |
|---|
| 18 | PRIVATE |
|---|
| 19 | |
|---|
| 20 | !! * Accessibility |
|---|
| 21 | PUBLIC dom_rea ! routine called by inidom.F90 |
|---|
| 22 | !!---------------------------------------------------------------------- |
|---|
| 23 | !! OPA 9.0 , LODYC-IPSL (2003) |
|---|
| 24 | !!---------------------------------------------------------------------- |
|---|
| 25 | |
|---|
| 26 | CONTAINS |
|---|
| 27 | |
|---|
| 28 | #if defined key_fdir |
|---|
| 29 | !!---------------------------------------------------------------------- |
|---|
| 30 | !! 'key_fdir' : direct access file |
|---|
| 31 | !!---------------------------------------------------------------------- |
|---|
| 32 | # include "domrea_fdir.h90" |
|---|
| 33 | |
|---|
| 34 | #elif ( defined key_mpp_mpi || defined key_mpp_shmem ) && defined key_dimgout |
|---|
| 35 | !!---------------------------------------------------------------------- |
|---|
| 36 | !! 'key_mpp_mpi' OR |
|---|
| 37 | !! 'key_mpp_shmem' |
|---|
| 38 | !! 'key_dimgout' : each processor makes its own direct access file |
|---|
| 39 | !! use build_nc_meshmask off line to retrieve |
|---|
| 40 | !! a ioipsl compliant meshmask file |
|---|
| 41 | !!---------------------------------------------------------------------- |
|---|
| 42 | # include "domrea_dimg.h90" |
|---|
| 43 | |
|---|
| 44 | |
|---|
| 45 | #else |
|---|
| 46 | !!---------------------------------------------------------------------- |
|---|
| 47 | !! Default option : NetCDF file |
|---|
| 48 | !!---------------------------------------------------------------------- |
|---|
| 49 | |
|---|
| 50 | SUBROUTINE dom_rea |
|---|
| 51 | !!---------------------------------------------------------------------- |
|---|
| 52 | !! *** ROUTINE dom_rea *** |
|---|
| 53 | !! |
|---|
| 54 | !! ** Purpose : Read the NetCDF file(s) which contain(s) all the |
|---|
| 55 | !! ocean domain informations (mesh and mask arrays). This (these) |
|---|
| 56 | !! file(s) is (are) used for visualisation (SAXO software) and |
|---|
| 57 | !! diagnostic computation. |
|---|
| 58 | !! |
|---|
| 59 | !! ** Method : Read in a file all the arrays generated in routines |
|---|
| 60 | !! domhgr, domzgr, and dommsk. Note: the file contain depends on |
|---|
| 61 | !! the vertical coord. used (z-coord, partial steps, s-coord) |
|---|
| 62 | !! nmsh = 1 : 'mesh_mask.nc' file |
|---|
| 63 | !! = 2 : 'mesh.nc' and mask.nc' files |
|---|
| 64 | !! = 3 : 'mesh_hgr.nc', 'mesh_zgr.nc' and |
|---|
| 65 | !! 'mask.nc' files |
|---|
| 66 | !! For huge size domain, use option 2 or 3 depending on your |
|---|
| 67 | !! vertical coordinate. |
|---|
| 68 | !! |
|---|
| 69 | !! ** input file : |
|---|
| 70 | !! meshmask.nc : domain size, horizontal grid-point position, |
|---|
| 71 | !! masks, depth and vertical scale factors |
|---|
| 72 | !! |
|---|
| 73 | !! History : |
|---|
| 74 | !! ! 97-02 (G. Madec) Original code |
|---|
| 75 | !! ! 99-11 (M. Imbard) NetCDF FORMAT with IOIPSL |
|---|
| 76 | !! 9.0 ! 02-08 (G. Madec) F90 and several file |
|---|
| 77 | !!---------------------------------------------------------------------- |
|---|
| 78 | !! * Modules used |
|---|
| 79 | USE ioipsl |
|---|
| 80 | |
|---|
| 81 | !! * Local declarations |
|---|
| 82 | LOGICAL :: llog |
|---|
| 83 | INTEGER :: ji, jj, jk, ik |
|---|
| 84 | INTEGER :: & !!! * temprary units for : |
|---|
| 85 | inum0 , & ! 'mesh_mask.nc' file |
|---|
| 86 | inum1 , & ! 'mesh.nc' file |
|---|
| 87 | inum2 , & ! 'mask.nc' file |
|---|
| 88 | inum3 , & ! 'mesh_hgr.nc' file |
|---|
| 89 | inum4 ! 'mesh_zgr.nc' file |
|---|
| 90 | INTEGER :: itime ! output from restini ??? |
|---|
| 91 | REAL(wp) :: zdate0, zdepwp, ze3tp, ze3wp |
|---|
| 92 | REAL(wp), DIMENSION(jpidta,jpjdta) :: & |
|---|
| 93 | zta ! dummy array for bathymetry |
|---|
| 94 | REAL(wp) , DIMENSION(jpidta,jpjdta,jpk) :: & |
|---|
| 95 | zt3a ! dummy array for bathymetry |
|---|
| 96 | REAL(wp), DIMENSION(jpi,jpj) :: & |
|---|
| 97 | zprt = 0. |
|---|
| 98 | |
|---|
| 99 | CHARACTER (len=21) :: & |
|---|
| 100 | clnam0 = 'mesh_mask', & ! filename (mesh and mask informations) |
|---|
| 101 | clnam1 = 'mesh' , & ! filename (mesh informations) |
|---|
| 102 | clnam2 = 'mask' , & ! filename (mask informations) |
|---|
| 103 | clnam3 = 'mesh_hgr' , & ! filename (horizontal mesh informations) |
|---|
| 104 | clnam4 = 'mesh_zgr' ! filename (vertical mesh informations) |
|---|
| 105 | !!---------------------------------------------------------------------- |
|---|
| 106 | |
|---|
| 107 | IF(lwp) WRITE(numout,*) |
|---|
| 108 | IF(lwp) WRITE(numout,*) 'dom_rea : read NetCDF mesh and mask information file(s)' |
|---|
| 109 | IF(lwp) WRITE(numout,*) '~~~~~~~' |
|---|
| 110 | |
|---|
| 111 | llog = .FALSE. |
|---|
| 112 | CALL ymds2ju( 0, 1, 1, 0.e0, zdate0 ) ! calendar initialization |
|---|
| 113 | |
|---|
| 114 | ! note that mbathy has been modified in dommsk or in solver. |
|---|
| 115 | ! it is the number of non-zero "w" levels in the water, and the minimum |
|---|
| 116 | ! value (on land) is 2. We define zprt as the number of "T" points in the ocean |
|---|
| 117 | ! at any location, and zero on land. |
|---|
| 118 | ! |
|---|
| 119 | |
|---|
| 120 | SELECT CASE (nmsh) |
|---|
| 121 | ! ! ============================ |
|---|
| 122 | CASE ( 1 ) ! create 'mesh_mask.nc' file |
|---|
| 123 | ! ! ============================ |
|---|
| 124 | |
|---|
| 125 | IF(lwp) WRITE(numout,*) ' one file in "mesh_mask.nc" ' |
|---|
| 126 | CALL restini( clnam0, jpidta , jpjdta , glamt, gphit, & ! create 'mesh_mask.nc' file |
|---|
| 127 | & jpk , gdept , trim(clnam0) , & ! in unit inum0 |
|---|
| 128 | & itime , zdate0, rdt , inum0 ) |
|---|
| 129 | inum2 = inum0 ! put all the informations |
|---|
| 130 | inum3 = inum0 ! in unit inum0 |
|---|
| 131 | inum4 = inum0 |
|---|
| 132 | |
|---|
| 133 | ! ! ============================ |
|---|
| 134 | CASE ( 2 ) ! create 'mesh.nc' and |
|---|
| 135 | ! ! 'mask.nc' files |
|---|
| 136 | ! ! ============================ |
|---|
| 137 | |
|---|
| 138 | IF(lwp) WRITE(numout,*) ' two files in "mesh.nc" and "mask.nc" ' |
|---|
| 139 | CALL restini( clnam1, jpidta , jpjdta , glamt, gphit, & ! create 'mesh.nc' file |
|---|
| 140 | & jpk , gdept , trim(clnam1) , & ! in unit inum1 |
|---|
| 141 | & itime , zdate0, rdt , inum1 ) |
|---|
| 142 | CALL restini( clnam2, jpidta , jpjdta , glamt, gphit, & ! create 'mask.nc' file |
|---|
| 143 | & jpk , gdept , trim(clnam2) , & ! in unit inum2 |
|---|
| 144 | & itime , zdate0, rdt , inum2 ) |
|---|
| 145 | inum3 = inum1 ! put mesh informations |
|---|
| 146 | inum4 = inum1 ! in unit inum1 |
|---|
| 147 | |
|---|
| 148 | ! ! ============================ |
|---|
| 149 | CASE ( 3 ) ! create 'mesh_hgr.nc' |
|---|
| 150 | ! ! 'mesh_zgr.nc' and |
|---|
| 151 | ! ! 'mask.nc' files |
|---|
| 152 | ! ! ============================ |
|---|
| 153 | |
|---|
| 154 | IF(lwp) WRITE(numout,*) ' three files in "mesh_hgr.nc" , mesh_zgr.nc" and "mask.nc" ' |
|---|
| 155 | CALL restini( clnam3, jpidta , jpjdta , glamt, gphit, & ! create 'mesh_hgr.nc' file |
|---|
| 156 | & jpk , gdept , trim(clnam3) , & ! in unit inum3 |
|---|
| 157 | & itime , zdate0, rdt , inum3 ) |
|---|
| 158 | CALL restini( clnam4, jpidta , jpjdta , glamt, gphit, & ! create 'mesh_zgr.nc' file |
|---|
| 159 | & jpk , gdept , trim(clnam4) , & ! in unit inum4 |
|---|
| 160 | & itime , zdate0, rdt , inum4 ) |
|---|
| 161 | CALL restini( clnam2, jpidta , jpjdta , glamt, gphit, & ! create 'mask.nc' file |
|---|
| 162 | & jpk , gdept , trim(clnam2) , & ! in unit inum2 |
|---|
| 163 | & itime , zdate0, rdt , inum2 ) |
|---|
| 164 | |
|---|
| 165 | END SELECT |
|---|
| 166 | |
|---|
| 167 | ! ! masks (inum2) |
|---|
| 168 | CALL restget( inum2, 'tmask', jpidta, jpjdta, jpk, 0, llog, zt3a ) |
|---|
| 169 | DO jk = 1, jpk |
|---|
| 170 | DO jj = 1, nlcj |
|---|
| 171 | DO ji = 1, nlci |
|---|
| 172 | tmask(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) |
|---|
| 173 | END DO |
|---|
| 174 | END DO |
|---|
| 175 | END DO |
|---|
| 176 | CALL restget( inum2, 'umask', jpidta, jpjdta, jpk, 0, llog, zt3a ) |
|---|
| 177 | DO jk = 1, jpk |
|---|
| 178 | DO jj = 1, nlcj |
|---|
| 179 | DO ji = 1, nlci |
|---|
| 180 | umask(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) |
|---|
| 181 | END DO |
|---|
| 182 | END DO |
|---|
| 183 | END DO |
|---|
| 184 | CALL restget( inum2, 'vmask', jpidta, jpjdta, jpk, 0, llog, zt3a ) |
|---|
| 185 | DO jk = 1, jpk |
|---|
| 186 | DO jj = 1, nlcj |
|---|
| 187 | DO ji = 1, nlci |
|---|
| 188 | vmask(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) |
|---|
| 189 | END DO |
|---|
| 190 | END DO |
|---|
| 191 | END DO |
|---|
| 192 | CALL restget( inum2, 'fmask', jpidta, jpjdta, jpk, 0, llog, zt3a ) |
|---|
| 193 | DO jk = 1, jpk |
|---|
| 194 | DO jj = 1, nlcj |
|---|
| 195 | DO ji = 1, nlci |
|---|
| 196 | fmask(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) |
|---|
| 197 | END DO |
|---|
| 198 | END DO |
|---|
| 199 | END DO |
|---|
| 200 | |
|---|
| 201 | ! ! horizontal mesh (inum3) |
|---|
| 202 | CALL restget( inum3, 'glamt', jpidta, jpjdta, 1, 0, llog, zta ) ! ! latitude |
|---|
| 203 | DO jj = 1, nlcj |
|---|
| 204 | DO ji = 1, nlci |
|---|
| 205 | glamt(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 206 | END DO |
|---|
| 207 | END DO |
|---|
| 208 | CALL restget( inum3, 'glamu', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 209 | DO jj = 1, nlcj |
|---|
| 210 | DO ji = 1, nlci |
|---|
| 211 | glamu(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 212 | END DO |
|---|
| 213 | END DO |
|---|
| 214 | CALL restget( inum3, 'glamv', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 215 | DO jj = 1, nlcj |
|---|
| 216 | DO ji = 1, nlci |
|---|
| 217 | glamv(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 218 | END DO |
|---|
| 219 | END DO |
|---|
| 220 | CALL restget( inum3, 'glamf', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 221 | DO jj = 1, nlcj |
|---|
| 222 | DO ji = 1, nlci |
|---|
| 223 | glamf(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 224 | END DO |
|---|
| 225 | END DO |
|---|
| 226 | |
|---|
| 227 | CALL restget( inum3, 'gphit', jpidta, jpjdta, 1, 0, llog, zta ) ! ! longitude |
|---|
| 228 | DO jj = 1, nlcj |
|---|
| 229 | DO ji = 1, nlci |
|---|
| 230 | gphit(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 231 | END DO |
|---|
| 232 | END DO |
|---|
| 233 | CALL restget( inum3, 'gphiu', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 234 | DO jj = 1, nlcj |
|---|
| 235 | DO ji = 1, nlci |
|---|
| 236 | gphiu(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 237 | END DO |
|---|
| 238 | END DO |
|---|
| 239 | CALL restget( inum3, 'gphiv', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 240 | DO jj = 1, nlcj |
|---|
| 241 | DO ji = 1, nlci |
|---|
| 242 | gphiv(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 243 | END DO |
|---|
| 244 | END DO |
|---|
| 245 | CALL restget( inum3, 'gphif', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 246 | DO jj = 1, nlcj |
|---|
| 247 | DO ji = 1, nlci |
|---|
| 248 | gphif(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 249 | END DO |
|---|
| 250 | END DO |
|---|
| 251 | |
|---|
| 252 | CALL restget( inum3, 'e1t', jpidta, jpjdta, 1, 0, llog, zta ) ! ! e1 scale factors |
|---|
| 253 | DO jj = 1, nlcj |
|---|
| 254 | DO ji = 1, nlci |
|---|
| 255 | e1t(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 256 | END DO |
|---|
| 257 | END DO |
|---|
| 258 | CALL restget( inum3, 'e1u', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 259 | DO jj = 1, nlcj |
|---|
| 260 | DO ji = 1, nlci |
|---|
| 261 | e1u(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 262 | END DO |
|---|
| 263 | END DO |
|---|
| 264 | CALL restget( inum3, 'e1v', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 265 | DO jj = 1, nlcj |
|---|
| 266 | DO ji = 1, nlci |
|---|
| 267 | e1v(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 268 | END DO |
|---|
| 269 | END DO |
|---|
| 270 | CALL restget( inum3, 'e2t', jpidta, jpjdta, 1, 0, llog, zta ) ! ! e2 scale factors |
|---|
| 271 | DO jj = 1, nlcj |
|---|
| 272 | DO ji = 1, nlci |
|---|
| 273 | e2t(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 274 | END DO |
|---|
| 275 | END DO |
|---|
| 276 | CALL restget( inum3, 'e2u', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 277 | DO jj = 1, nlcj |
|---|
| 278 | DO ji = 1, nlci |
|---|
| 279 | e2u(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 280 | END DO |
|---|
| 281 | END DO |
|---|
| 282 | CALL restget( inum3, 'e2v', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 283 | DO jj = 1, nlcj |
|---|
| 284 | DO ji = 1, nlci |
|---|
| 285 | e2v(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 286 | END DO |
|---|
| 287 | END DO |
|---|
| 288 | CALL restget( inum3, 'ff', jpidta, jpjdta, 1, 0, llog, zta ) ! ! coriolis factor |
|---|
| 289 | DO jj = 1, nlcj |
|---|
| 290 | DO ji = 1, nlci |
|---|
| 291 | ff(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 292 | END DO |
|---|
| 293 | END DO |
|---|
| 294 | |
|---|
| 295 | CALL restget( inum4, 'mbathy', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 296 | ! Bathymetry |
|---|
| 297 | DO jj = 1, nlcj |
|---|
| 298 | DO ji = 1, nlci |
|---|
| 299 | zprt(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 300 | END DO |
|---|
| 301 | END DO |
|---|
| 302 | |
|---|
| 303 | mbathy(:,:)=zprt(:,:)*tmask(:,:,1)+1 |
|---|
| 304 | |
|---|
| 305 | # if defined key_s_coord |
|---|
| 306 | ! ! s-coordinate |
|---|
| 307 | CALL restget( inum4, 'hbatt', jpidta, jpjdta, 1, 0, llog, zta ) ! ! depth |
|---|
| 308 | DO jj = 1, nlcj |
|---|
| 309 | DO ji = 1, nlci |
|---|
| 310 | hbatt(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 311 | END DO |
|---|
| 312 | END DO |
|---|
| 313 | CALL restget( inum4, 'hbatu', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 314 | DO jj = 1, nlcj |
|---|
| 315 | DO ji = 1, nlci |
|---|
| 316 | hbatu(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 317 | END DO |
|---|
| 318 | END DO |
|---|
| 319 | CALL restget( inum4, 'hbatv', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 320 | DO jj = 1, nlcj |
|---|
| 321 | DO ji = 1, nlci |
|---|
| 322 | hbatv(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 323 | END DO |
|---|
| 324 | END DO |
|---|
| 325 | CALL restget( inum4, 'hbatf', jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 326 | DO jj = 1, nlcj |
|---|
| 327 | DO ji = 1, nlci |
|---|
| 328 | hbatf(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 329 | END DO |
|---|
| 330 | END DO |
|---|
| 331 | |
|---|
| 332 | CALL restget( inum4, 'gsigt', 1, 1, jpk, 0, llog, gsigt ) ! ! scaling coef. |
|---|
| 333 | CALL restget( inum4, 'gsigw', 1, 1, jpk, 0, llog, gsigw ) |
|---|
| 334 | CALL restget( inum4, 'gsi3w', 1, 1, jpk, 0, llog, gsi3w ) |
|---|
| 335 | CALL restget( inum4, 'esigt', 1, 1, jpk, 0, llog, esigt ) |
|---|
| 336 | CALL restget( inum4, 'esigw', 1, 1, jpk, 0, llog, esigw ) |
|---|
| 337 | |
|---|
| 338 | # elif defined key_partial_steps |
|---|
| 339 | ! ! z-coordinate with partial steps |
|---|
| 340 | CALL restget( inum4, 'hdept' , jpidta, jpjdta, 1, 0, llog, zta ) ! ! depth |
|---|
| 341 | DO jj = 1, nlcj |
|---|
| 342 | DO ji = 1, nlci |
|---|
| 343 | hdept(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 344 | END DO |
|---|
| 345 | END DO |
|---|
| 346 | CALL restget( inum4, 'hdepw' , jpidta, jpjdta, 1, 0, llog, zta ) |
|---|
| 347 | DO jj = 1, nlcj |
|---|
| 348 | DO ji = 1, nlci |
|---|
| 349 | hdepw(ji,jj) = zta(mig(ji),mjg(jj)) |
|---|
| 350 | END DO |
|---|
| 351 | END DO |
|---|
| 352 | |
|---|
| 353 | CALL restget( inum4, 'e3t_ps', jpidta, jpjdta, jpk, 0, llog, zt3a ) ! ! scale factors |
|---|
| 354 | DO jk = 1, jpk |
|---|
| 355 | DO jj = 1, nlcj |
|---|
| 356 | DO ji = 1, nlci |
|---|
| 357 | e3t_ps(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) |
|---|
| 358 | END DO |
|---|
| 359 | END DO |
|---|
| 360 | END DO |
|---|
| 361 | CALL restget( inum4, 'e3u_ps', jpidta, jpjdta, jpk, 0, llog, zt3a ) |
|---|
| 362 | DO jk = 1, jpk |
|---|
| 363 | DO jj = 1, nlcj |
|---|
| 364 | DO ji = 1, nlci |
|---|
| 365 | e3u_ps(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) |
|---|
| 366 | END DO |
|---|
| 367 | END DO |
|---|
| 368 | END DO |
|---|
| 369 | CALL restget( inum4, 'e3v_ps', jpidta, jpjdta, jpk, 0, llog, zt3a ) |
|---|
| 370 | DO jk = 1, jpk |
|---|
| 371 | DO jj = 1, nlcj |
|---|
| 372 | DO ji = 1, nlci |
|---|
| 373 | e3v_ps(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) |
|---|
| 374 | END DO |
|---|
| 375 | END DO |
|---|
| 376 | END DO |
|---|
| 377 | CALL restget( inum4, 'e3w_ps', jpidta, jpjdta, jpk, 0, llog, zt3a ) |
|---|
| 378 | DO jk = 1, jpk |
|---|
| 379 | DO jj = 1, nlcj |
|---|
| 380 | DO ji = 1, nlci |
|---|
| 381 | e3w_ps(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) |
|---|
| 382 | END DO |
|---|
| 383 | END DO |
|---|
| 384 | END DO |
|---|
| 385 | |
|---|
| 386 | CALL restget( inum4, 'gdept' , 1, 1, jpk, 0, llog, gdept ) ! ! reference z-coord. |
|---|
| 387 | CALL restget( inum4, 'gdepw' , 1, 1, jpk, 0, llog, gdepw ) |
|---|
| 388 | CALL restget( inum4, 'e3t' , 1, 1, jpk, 0, llog, e3t ) |
|---|
| 389 | CALL restget( inum4, 'e3w' , 1, 1, jpk, 0, llog, e3w ) |
|---|
| 390 | |
|---|
| 391 | do jk=1,jpk |
|---|
| 392 | gdept_ps(:,:,jk) = gdept(jk) |
|---|
| 393 | gdepw_ps(:,:,jk) = gdepw(jk) |
|---|
| 394 | end do |
|---|
| 395 | |
|---|
| 396 | DO jj = 1, jpj |
|---|
| 397 | DO ji = 1, jpi |
|---|
| 398 | ik = mbathy(ji,jj) |
|---|
| 399 | ! ocean point only |
|---|
| 400 | IF( ik > 0 ) THEN |
|---|
| 401 | ! max ocean level case |
|---|
| 402 | IF( ik == jpkm1 ) THEN |
|---|
| 403 | zdepwp = mbathy(ji,jj) |
|---|
| 404 | ze3tp = mbathy(ji,jj) - gdepw(ik) |
|---|
| 405 | ze3wp = 0.5 * e3w(ik) * ( 1. + ( ze3tp/e3t(ik) ) ) |
|---|
| 406 | gdepw_ps(ji,jj,ik+1) = zdepwp |
|---|
| 407 | gdept_ps(ji,jj,ik ) = gdept(ik-1) + ze3wp |
|---|
| 408 | gdept_ps(ji,jj,ik+1) = gdept_ps(ji,jj,ik) + ze3tp |
|---|
| 409 | ! standard case |
|---|
| 410 | ELSE |
|---|
| 411 | !!alex |
|---|
| 412 | IF( mbathy(ji,jj) <= gdepw(ik+1) ) THEN |
|---|
| 413 | gdepw_ps(ji,jj,ik+1) = mbathy(ji,jj) |
|---|
| 414 | ELSE |
|---|
| 415 | gdepw_ps(ji,jj,ik+1) = gdepw(ik+1) |
|---|
| 416 | ENDIF |
|---|
| 417 | !!Alex |
|---|
| 418 | !!Alex gdepw_ps(ji,jj,ik+1) = mbathy(ji,jj) |
|---|
| 419 | gdept_ps(ji,jj,ik ) = gdepw(ik) + ( gdepw_ps(ji,jj,ik+1) - gdepw(ik)) & |
|---|
| 420 | * ((gdept ( ik ) - gdepw(ik)) & |
|---|
| 421 | / ( gdepw ( ik+1) - gdepw(ik))) |
|---|
| 422 | gdept_ps(ji,jj,ik+1) = gdept_ps(ji,jj,ik) + e3t_ps (ji,jj,ik) |
|---|
| 423 | ENDIF |
|---|
| 424 | ENDIF |
|---|
| 425 | END DO |
|---|
| 426 | END DO |
|---|
| 427 | |
|---|
| 428 | |
|---|
| 429 | # else |
|---|
| 430 | ! ! z-coordinate |
|---|
| 431 | CALL restget( inum4, 'gdept', 1, 1, jpk, 0, llog, gdept ) ! ! depth |
|---|
| 432 | CALL restget( inum4, 'gdepw', 1, 1, jpk, 0, llog, gdepw ) |
|---|
| 433 | CALL restget( inum4, 'e3t' , 1, 1, jpk, 0, llog, e3t ) ! ! scale factors |
|---|
| 434 | CALL restget( inum4, 'e3w' , 1, 1, jpk, 0, llog, e3w ) |
|---|
| 435 | # endif |
|---|
| 436 | |
|---|
| 437 | ! Control printing : Grid informations (if not restart) |
|---|
| 438 | ! ---------------- |
|---|
| 439 | |
|---|
| 440 | IF(lwp .AND. .NOT.ln_rstart ) THEN |
|---|
| 441 | WRITE(numout,*) |
|---|
| 442 | WRITE(numout,*) ' longitude and e1 scale factors' |
|---|
| 443 | WRITE(numout,*) ' ------------------------------' |
|---|
| 444 | WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1), & |
|---|
| 445 | glamv(ji,1), glamf(ji,1), & |
|---|
| 446 | e1t(ji,1), e1u(ji,1), & |
|---|
| 447 | e1v(ji,1), ji = 1, jpi,10) |
|---|
| 448 | 9300 FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x, & |
|---|
| 449 | f19.10, 1x, f19.10, 1x, f19.10 ) |
|---|
| 450 | |
|---|
| 451 | WRITE(numout,*) |
|---|
| 452 | WRITE(numout,*) ' latitude and e2 scale factors' |
|---|
| 453 | WRITE(numout,*) ' -----------------------------' |
|---|
| 454 | WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj), & |
|---|
| 455 | & gphiv(1,jj), gphif(1,jj), & |
|---|
| 456 | & e2t (1,jj), e2u (1,jj), & |
|---|
| 457 | & e2v (1,jj), jj = 1, jpj, 10 ) |
|---|
| 458 | ENDIF |
|---|
| 459 | |
|---|
| 460 | |
|---|
| 461 | IF( nprint == 1 .AND. lwp ) THEN |
|---|
| 462 | WRITE(numout,*) ' e1u e2u ' |
|---|
| 463 | CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) |
|---|
| 464 | CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) |
|---|
| 465 | WRITE(numout,*) ' e1v e2v ' |
|---|
| 466 | CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) |
|---|
| 467 | CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) |
|---|
| 468 | ENDIF |
|---|
| 469 | |
|---|
| 470 | IF(lwp) THEN |
|---|
| 471 | WRITE(numout,*) |
|---|
| 472 | WRITE(numout,*) ' Reference z-coordinate depth and scale factors:' |
|---|
| 473 | WRITE(numout, "(9x,' level gdept gdepw e3t e3w ')" ) |
|---|
| 474 | WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept(jk), gdepw(jk), e3t(jk), e3w(jk), jk = 1, jpk ) |
|---|
| 475 | ENDIF |
|---|
| 476 | |
|---|
| 477 | DO jk = 1, jpk |
|---|
| 478 | IF( e3w(jk) <= 0. .OR. e3t(jk) <= 0. ) THEN |
|---|
| 479 | IF(lwp) WRITE(numout,cform_err) |
|---|
| 480 | IF(lwp) WRITE(numout,*) ' e3w or e3t =< 0 ' |
|---|
| 481 | nstop = nstop + 1 |
|---|
| 482 | ENDIF |
|---|
| 483 | IF( gdepw(jk) < 0. .OR. gdept(jk) < 0.) THEN |
|---|
| 484 | IF(lwp) WRITE(numout,cform_err) |
|---|
| 485 | IF(lwp) WRITE(numout,*) ' gdepw or gdept < 0 ' |
|---|
| 486 | nstop = nstop + 1 |
|---|
| 487 | ENDIF |
|---|
| 488 | END DO |
|---|
| 489 | |
|---|
| 490 | ! ! ============================ |
|---|
| 491 | ! ! close the files |
|---|
| 492 | ! ! ============================ |
|---|
| 493 | SELECT CASE ( nmsh ) |
|---|
| 494 | CASE ( 1 ) |
|---|
| 495 | CALL restclo( inum0 ) |
|---|
| 496 | CASE ( 2 ) |
|---|
| 497 | CALL restclo( inum1 ) |
|---|
| 498 | CALL restclo( inum2 ) |
|---|
| 499 | CASE ( 3 ) |
|---|
| 500 | CALL restclo( inum2 ) |
|---|
| 501 | CALL restclo( inum3 ) |
|---|
| 502 | CALL restclo( inum4 ) |
|---|
| 503 | END SELECT |
|---|
| 504 | |
|---|
| 505 | END SUBROUTINE dom_rea |
|---|
| 506 | |
|---|
| 507 | #endif |
|---|
| 508 | |
|---|
| 509 | !!====================================================================== |
|---|
| 510 | END MODULE domrea |
|---|
