Changeset 5600 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OFF_SRC/domrea.F90
- Timestamp:
- 2015-07-15T17:46:12+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r5034 r5600 1 1 MODULE domrea 2 !!====================================================================== 3 !! *** MODULE domrea ***4 !! Ocean initialization : read the ocean domain meshmask file(s)5 !!====================================================================== 6 !! History : 3.3 ! 2010-05 (C. Ethe) Full reorganization of the off-line 2 !!============================================================================== 3 !! *** MODULE domrea *** 4 !! Ocean initialization : domain initialization 5 !!============================================================================== 6 7 7 !!---------------------------------------------------------------------- 8 8 !! dom_init : initialize the space and time domain 9 !! dom_nam : read and contral domain namelists 10 !! dom_ctl : control print for the ocean domain 9 11 !!---------------------------------------------------------------------- 10 !! dom_rea : read mesh and mask file(s) 11 !! nmsh = 1 : mesh_mask file 12 !! = 2 : mesh and mask file 13 !! = 3 : mesh_hgr, mesh_zgr and mask 14 !!---------------------------------------------------------------------- 12 !! * Modules used 13 USE oce ! 15 14 USE dom_oce ! ocean space and time domain 16 USE dommsk ! domain: masks 15 USE phycst ! physical constants 16 USE in_out_manager ! I/O manager 17 USE lib_mpp ! distributed memory computing library 18 19 USE domstp ! domain: set the time-step 20 17 21 USE lbclnk ! lateral boundary condition - MPP exchanges 18 22 USE trc_oce ! shared ocean/biogeochemical variables 19 USE lib_mpp20 USE in_out_manager21 23 USE wrk_nemo 22 24 23 25 IMPLICIT NONE 24 26 PRIVATE 25 27 26 PUBLIC dom_rea ! routine called by inidom.F90 27 !! * Substitutions 28 !! * Routine accessibility 29 PUBLIC dom_rea ! called by opa.F90 30 31 !! * Substitutions 28 32 # include "domzgr_substitute.h90" 33 # include "vectopt_loop_substitute.h90" 29 34 !!---------------------------------------------------------------------- 30 35 !! NEMO/OFF 3.3 , NEMO Consortium (2010) 31 36 !! $Id$ 32 !! Software governed by the CeCILL licence 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 38 !!---------------------------------------------------------------------- 39 34 40 CONTAINS 35 41 … … 37 43 !!---------------------------------------------------------------------- 38 44 !! *** ROUTINE dom_rea *** 45 !! 46 !! ** Purpose : Domain initialization. Call the routines that are 47 !! required to create the arrays which define the space and time 48 !! domain of the ocean model. 49 !! 50 !! ** Method : 51 !! - dom_stp: defined the model time step 52 !! - dom_rea: read the meshmask file if nmsh=1 53 !! 54 !! History : 55 !! ! 90-10 (C. Levy - G. Madec) Original code 56 !! ! 91-11 (G. Madec) 57 !! ! 92-01 (M. Imbard) insert time step initialization 58 !! ! 96-06 (G. Madec) generalized vertical coordinate 59 !! ! 97-02 (G. Madec) creation of domwri.F 60 !! ! 01-05 (E.Durand - G. Madec) insert closed sea 61 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 62 !!---------------------------------------------------------------------- 63 !! * Local declarations 64 INTEGER :: jk ! dummy loop argument 65 INTEGER :: iconf = 0 ! temporary integers 66 !!---------------------------------------------------------------------- 67 68 IF(lwp) THEN 69 WRITE(numout,*) 70 WRITE(numout,*) 'dom_init : domain initialization' 71 WRITE(numout,*) '~~~~~~~~' 72 ENDIF 73 74 CALL dom_nam ! read namelist ( namrun, namdom, namcla ) 75 CALL dom_zgr ! Vertical mesh and bathymetry option 76 CALL dom_grd ! Create a domain file 77 78 ! 79 ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines 80 ! but could be usefull in many other routines 81 e12t (:,:) = e1t(:,:) * e2t(:,:) 82 e1e2t (:,:) = e1t(:,:) * e2t(:,:) 83 e12u (:,:) = e1u(:,:) * e2u(:,:) 84 e12v (:,:) = e1v(:,:) * e2v(:,:) 85 e12f (:,:) = e1f(:,:) * e2f(:,:) 86 r1_e12t (:,:) = 1._wp / e12t(:,:) 87 r1_e12u (:,:) = 1._wp / e12u(:,:) 88 r1_e12v (:,:) = 1._wp / e12v(:,:) 89 r1_e12f (:,:) = 1._wp / e12f(:,:) 90 re2u_e1u(:,:) = e2u(:,:) / e1u(:,:) 91 re1v_e2v(:,:) = e1v(:,:) / e2v(:,:) 92 ! 93 hu(:,:) = 0._wp ! Ocean depth at U- and V-points 94 hv(:,:) = 0._wp 95 DO jk = 1, jpk 96 hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 97 hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 98 END DO 99 ! ! Inverse of the local depth 100 hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 101 hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 102 103 CALL dom_stp ! Time step 104 CALL dom_msk ! Masks 105 CALL dom_ctl ! Domain control 106 107 END SUBROUTINE dom_rea 108 109 SUBROUTINE dom_nam 110 !!---------------------------------------------------------------------- 111 !! *** ROUTINE dom_nam *** 112 !! 113 !! ** Purpose : read domaine namelists and print the variables. 114 !! 115 !! ** input : - namrun namelist 116 !! - namdom namelist 117 !! - namcla namelist 118 !!---------------------------------------------------------------------- 119 USE ioipsl 120 INTEGER :: ios ! Local integer output status for namelist read 121 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, & 122 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, & 123 & nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , & 124 & nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler 125 NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh , rn_hmin, & 126 & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , & 127 & rn_rdtmax, rn_rdth , nn_baro , nn_closea , ln_crs, & 128 & jphgr_msh, & 129 & ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & 130 & ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 131 & ppa2, ppkth2, ppacr2 132 NAMELIST/namcla/ nn_cla 133 #if defined key_netcdf4 134 NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 135 #endif 136 !!---------------------------------------------------------------------- 137 138 REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run 139 READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 140 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp ) 141 142 REWIND( numnam_cfg ) ! Namelist namrun in configuration namelist : Parameters of the run 143 READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) 144 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp ) 145 IF(lwm) WRITE ( numond, namrun ) 146 ! 147 IF(lwp) THEN ! control print 148 WRITE(numout,*) 149 WRITE(numout,*) 'dom_nam : domain initialization through namelist read' 150 WRITE(numout,*) '~~~~~~~ ' 151 WRITE(numout,*) ' Namelist namrun' 152 WRITE(numout,*) ' job number nn_no = ', nn_no 153 WRITE(numout,*) ' experiment name for output cn_exp = ', cn_exp 154 WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart 155 WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl 156 WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000 157 WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend 158 WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0 159 WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy 160 WRITE(numout,*) ' initial state output nn_istate = ', nn_istate 161 WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock 162 WRITE(numout,*) ' frequency of output file nn_write = ', nn_write 163 WRITE(numout,*) ' multi file dimgout ln_dimgnnn = ', ln_dimgnnn 164 WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland 165 WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta 166 WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber 167 WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz 168 ENDIF 169 no = nn_no ! conversion DOCTOR names into model names (this should disappear soon) 170 cexper = cn_exp 171 nrstdt = nn_rstctl 172 nit000 = nn_it000 173 nitend = nn_itend 174 ndate0 = nn_date0 175 nleapy = nn_leapy 176 ninist = nn_istate 177 nstock = nn_stock 178 nstocklist = nn_stocklist 179 nwrite = nn_write 180 181 182 ! ! control of output frequency 183 IF ( nstock == 0 .OR. nstock > nitend ) THEN 184 WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend 185 CALL ctl_warn( ctmp1 ) 186 nstock = nitend 187 ENDIF 188 IF ( nwrite == 0 ) THEN 189 WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend 190 CALL ctl_warn( ctmp1 ) 191 nwrite = nitend 192 ENDIF 193 194 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 195 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 196 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 197 198 #if defined key_agrif 199 IF( Agrif_Root() ) THEN 200 #endif 201 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 202 CASE ( 1 ) 203 CALL ioconf_calendar('gregorian') 204 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year' 205 CASE ( 0 ) 206 CALL ioconf_calendar('noleap') 207 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year' 208 CASE ( 30 ) 209 CALL ioconf_calendar('360d') 210 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year' 211 END SELECT 212 #if defined key_agrif 213 ENDIF 214 #endif 215 216 REWIND( numnam_ref ) ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep) 217 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 218 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 219 220 REWIND( numnam_cfg ) ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 221 READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 222 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 223 IF(lwm) WRITE ( numond, namdom ) 224 225 IF(lwp) THEN 226 WRITE(numout,*) 227 WRITE(numout,*) ' Namelist namdom : space & time domain' 228 WRITE(numout,*) ' flag read/compute bathymetry nn_bathy = ', nn_bathy 229 WRITE(numout,*) ' Depth (if =0 bathy=jpkm1) rn_bathy = ', rn_bathy 230 WRITE(numout,*) ' min depth of the ocean (>0) or rn_hmin = ', rn_hmin 231 WRITE(numout,*) ' minimum thickness of partial rn_e3zps_min = ', rn_e3zps_min, ' (m)' 232 WRITE(numout,*) ' step level rn_e3zps_rat = ', rn_e3zps_rat 233 WRITE(numout,*) ' create mesh/mask file(s) nn_msh = ', nn_msh 234 WRITE(numout,*) ' = 0 no file created ' 235 WRITE(numout,*) ' = 1 mesh_mask ' 236 WRITE(numout,*) ' = 2 mesh and mask ' 237 WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask ' 238 WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt 239 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 240 WRITE(numout,*) ' time-splitting: nb of sub time-step nn_baro = ', nn_baro 241 WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc 242 WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin 243 WRITE(numout,*) ' bottom tracer rdt rdtmax = ', rn_rdtmax 244 WRITE(numout,*) ' depth of transition rn_rdth = ', rn_rdth 245 WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea 246 WRITE(numout,*) ' type of horizontal mesh jphgr_msh = ', jphgr_msh 247 WRITE(numout,*) ' longitude of first raw and column T-point ppglam0 = ', ppglam0 248 WRITE(numout,*) ' latitude of first raw and column T-point ppgphi0 = ', ppgphi0 249 WRITE(numout,*) ' zonal grid-spacing (degrees) ppe1_deg = ', ppe1_deg 250 WRITE(numout,*) ' meridional grid-spacing (degrees) ppe2_deg = ', ppe2_deg 251 WRITE(numout,*) ' zonal grid-spacing (degrees) ppe1_m = ', ppe1_m 252 WRITE(numout,*) ' meridional grid-spacing (degrees) ppe2_m = ', ppe2_m 253 WRITE(numout,*) ' ORCA r4, r2 and r05 coefficients ppsur = ', ppsur 254 WRITE(numout,*) ' ppa0 = ', ppa0 255 WRITE(numout,*) ' ppa1 = ', ppa1 256 WRITE(numout,*) ' ppkth = ', ppkth 257 WRITE(numout,*) ' ppacr = ', ppacr 258 WRITE(numout,*) ' Minimum vertical spacing ppdzmin = ', ppdzmin 259 WRITE(numout,*) ' Maximum depth pphmax = ', pphmax 260 WRITE(numout,*) ' Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh 261 WRITE(numout,*) ' Double tanh function parameters ppa2 = ', ppa2 262 WRITE(numout,*) ' ppkth2 = ', ppkth2 263 WRITE(numout,*) ' ppacr2 = ', ppacr2 264 ENDIF 265 266 ntopo = nn_bathy ! conversion DOCTOR names into model names (this should disappear soon) 267 e3zps_min = rn_e3zps_min 268 e3zps_rat = rn_e3zps_rat 269 nmsh = nn_msh 270 nacc = nn_acc 271 atfp = rn_atfp 272 rdt = rn_rdt 273 rdtmin = rn_rdtmin 274 rdtmax = rn_rdtmin 275 rdth = rn_rdth 276 277 REWIND( numnam_ref ) ! Namelist namcla in reference namelist : Cross land advection 278 READ ( numnam_ref, namcla, IOSTAT = ios, ERR = 905) 279 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp ) 280 281 REWIND( numnam_cfg ) ! Namelist namcla in configuration namelist : Cross land advection 282 READ ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 ) 283 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp ) 284 IF(lwm) WRITE( numond, namcla ) 285 286 IF(lwp) THEN 287 WRITE(numout,*) 288 WRITE(numout,*) ' Namelist namcla' 289 WRITE(numout,*) ' cross land advection nn_cla = ', nn_cla 290 ENDIF 291 292 #if defined key_netcdf4 293 ! ! NetCDF 4 case ("key_netcdf4" defined) 294 REWIND( numnam_ref ) ! Namelist namnc4 in reference namelist : NETCDF 295 READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 296 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp ) 297 298 REWIND( numnam_cfg ) ! Namelist namnc4 in configuration namelist : NETCDF 299 READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 ) 300 908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp ) 301 IF(lwm) WRITE( numond, namnc4 ) 302 IF(lwp) THEN ! control print 303 WRITE(numout,*) 304 WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters' 305 WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i 306 WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j 307 WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k 308 WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip 309 ENDIF 310 311 ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module) 312 ! Note the chunk size in the unlimited (time) dimension will be fixed at 1 313 snc4set%ni = nn_nchunks_i 314 snc4set%nj = nn_nchunks_j 315 snc4set%nk = nn_nchunks_k 316 snc4set%luse = ln_nc4zip 317 #else 318 snc4set%luse = .FALSE. ! No NetCDF 4 case 319 #endif 320 ! 321 END SUBROUTINE dom_nam 322 323 SUBROUTINE dom_zgr 324 !!---------------------------------------------------------------------- 325 !! *** ROUTINE dom_zgr *** 326 !! 327 !! ** Purpose : set the depth of model levels and the resulting 328 !! vertical scale factors. 329 !! 330 !! ** Method : - reference 1D vertical coordinate (gdep._1d, e3._1d) 331 !! - read/set ocean depth and ocean levels (bathy, mbathy) 332 !! - vertical coordinate (gdep., e3.) depending on the 333 !! coordinate chosen : 334 !! ln_zco=T z-coordinate 335 !! ln_zps=T z-coordinate with partial steps 336 !! ln_zco=T s-coordinate 337 !! 338 !! ** Action : define gdep., e3., mbathy and bathy 339 !!---------------------------------------------------------------------- 340 INTEGER :: ioptio = 0 ! temporary integer 341 INTEGER :: ios 342 !! 343 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 344 !!---------------------------------------------------------------------- 345 346 REWIND( numnam_ref ) ! Namelist namzgr in reference namelist : Vertical coordinate 347 READ ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 ) 348 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp ) 349 350 REWIND( numnam_cfg ) ! Namelist namzgr in configuration namelist : Vertical coordinate 351 READ ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 ) 352 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp ) 353 IF(lwm) WRITE ( numond, namzgr ) 354 355 IF(lwp) THEN ! Control print 356 WRITE(numout,*) 357 WRITE(numout,*) 'dom_zgr : vertical coordinate' 358 WRITE(numout,*) '~~~~~~~' 359 WRITE(numout,*) ' Namelist namzgr : set vertical coordinate' 360 WRITE(numout,*) ' z-coordinate - full steps ln_zco = ', ln_zco 361 WRITE(numout,*) ' z-coordinate - partial steps ln_zps = ', ln_zps 362 WRITE(numout,*) ' s- or hybrid z-s-coordinate ln_sco = ', ln_sco 363 WRITE(numout,*) ' ice shelf cavity ln_isfcav = ', ln_isfcav 364 ENDIF 365 366 ioptio = 0 ! Check Vertical coordinate options 367 IF( ln_zco ) ioptio = ioptio + 1 368 IF( ln_zps ) ioptio = ioptio + 1 369 IF( ln_sco ) ioptio = ioptio + 1 370 IF( ln_isfcav ) ioptio = 33 371 IF ( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' ) 372 IF ( ioptio == 33 ) CALL ctl_stop( ' isf cavity with off line module not yet done ' ) 373 374 END SUBROUTINE dom_zgr 375 376 SUBROUTINE dom_ctl 377 !!---------------------------------------------------------------------- 378 !! *** ROUTINE dom_ctl *** 379 !! 380 !! ** Purpose : Domain control. 381 !! 382 !! ** Method : compute and print extrema of masked scale factors 383 !! 384 !! History : 385 !! 8.5 ! 02-08 (G. Madec) Original code 386 !!---------------------------------------------------------------------- 387 !! * Local declarations 388 INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 389 INTEGER, DIMENSION(2) :: iloc ! 390 REAL(wp) :: ze1min, ze1max, ze2min, ze2max 391 !!---------------------------------------------------------------------- 392 393 ! Extrema of the scale factors 394 395 IF(lwp)WRITE(numout,*) 396 IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 397 IF(lwp)WRITE(numout,*) '~~~~~~~' 398 399 IF (lk_mpp) THEN 400 CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 ) 401 CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 ) 402 CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 ) 403 CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 ) 404 ELSE 405 ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 406 ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 407 ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 408 ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 409 410 iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 411 iimi1 = iloc(1) + nimpp - 1 412 ijmi1 = iloc(2) + njmpp - 1 413 iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 414 iimi2 = iloc(1) + nimpp - 1 415 ijmi2 = iloc(2) + njmpp - 1 416 iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 417 iima1 = iloc(1) + nimpp - 1 418 ijma1 = iloc(2) + njmpp - 1 419 iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 420 iima2 = iloc(1) + nimpp - 1 421 ijma2 = iloc(2) + njmpp - 1 422 ENDIF 423 424 IF(lwp) THEN 425 WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1 426 WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1 427 WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2 428 WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2 429 ENDIF 430 431 END SUBROUTINE dom_ctl 432 433 SUBROUTINE dom_grd 434 !!---------------------------------------------------------------------- 435 !! *** ROUTINE dom_grd *** 39 436 !! 40 437 !! ** Purpose : Read the NetCDF file(s) which contain(s) all the … … 344 741 CALL wrk_dealloc( jpi, jpj, zmbk, zprt, zprw ) 345 742 ! 346 END SUBROUTINE dom_ rea743 END SUBROUTINE dom_grd 347 744 348 745 … … 388 785 END SUBROUTINE zgr_bot_level 389 786 787 SUBROUTINE dom_msk 788 !!--------------------------------------------------------------------- 789 !! *** ROUTINE dom_msk *** 790 !! 791 !! ** Purpose : Off-line case: defines the interior domain T-mask. 792 !! 793 !! ** Method : The interior ocean/land mask is computed from tmask 794 !! setting to zero the duplicated row and lines due to 795 !! MPP exchange halos, est-west cyclic and north fold 796 !! boundary conditions. 797 !! 798 !! ** Action : tmask_i : interiorland/ocean mask at t-point 799 !! tpol : ??? 800 !!---------------------------------------------------------------------- 801 ! 802 INTEGER :: ji, jj, jk ! dummy loop indices 803 INTEGER :: iif, iil, ijf, ijl ! local integers 804 INTEGER, POINTER, DIMENSION(:,:) :: imsk 805 ! 806 !!--------------------------------------------------------------------- 807 808 CALL wrk_alloc( jpi, jpj, imsk ) 809 ! 810 ! Interior domain mask (used for global sum) 811 ! -------------------- 812 ssmask(:,:) = tmask(:,:,1) 813 tmask_i(:,:) = tmask(:,:,1) 814 iif = jpreci ! thickness of exchange halos in i-axis 815 iil = nlci - jpreci + 1 816 ijf = jprecj ! thickness of exchange halos in j-axis 817 ijl = nlcj - jprecj + 1 818 ! 819 tmask_i( 1 :iif, : ) = 0._wp ! first columns 820 tmask_i(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns) 821 tmask_i( : , 1 :ijf) = 0._wp ! first rows 822 tmask_i( : ,ijl:jpj) = 0._wp ! last rows (including mpp extra rows) 823 ! 824 ! ! north fold mask 825 tpol(1:jpiglo) = 1._wp 826 ! 827 IF( jperio == 3 .OR. jperio == 4 ) tpol(jpiglo/2+1:jpiglo) = 0._wp ! T-point pivot 828 IF( jperio == 5 .OR. jperio == 6 ) tpol( 1 :jpiglo) = 0._wp ! F-point pivot 829 IF( jperio == 3 .OR. jperio == 4 ) THEN ! T-point pivot: only half of the nlcj-1 row 830 IF( mjg(ijl-1) == jpjglo-1 ) THEN 831 DO ji = iif+1, iil-1 832 tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji)) 833 END DO 834 ENDIF 835 ENDIF 836 ! 837 ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at 838 ! least 1 wet u point 839 DO jj = 1, jpjm1 840 DO ji = 1, fs_jpim1 ! vector loop 841 umask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji+1,jj ) * MIN(1._wp,SUM(umask(ji,jj,:))) 842 vmask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji ,jj+1) * MIN(1._wp,SUM(vmask(ji,jj,:))) 843 END DO 844 DO ji = 1, jpim1 ! NO vector opt. 845 fmask_i(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) & 846 & * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 847 END DO 848 END DO 849 CALL lbc_lnk( umask_i, 'U', 1._wp ) ! Lateral boundary conditions 850 CALL lbc_lnk( vmask_i, 'V', 1._wp ) 851 CALL lbc_lnk( fmask_i, 'F', 1._wp ) 852 853 ! 3. Ocean/land mask at wu-, wv- and w points 854 !---------------------------------------------- 855 wmask (:,:,1) = tmask(:,:,1) ! ???????? 856 wumask(:,:,1) = umask(:,:,1) ! ???????? 857 wvmask(:,:,1) = vmask(:,:,1) ! ???????? 858 DO jk=2,jpk 859 wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1) 860 wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1) 861 wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1) 862 END DO 863 ! 864 IF( nprint == 1 .AND. lwp ) THEN ! Control print 865 imsk(:,:) = INT( tmask_i(:,:) ) 866 WRITE(numout,*) ' tmask_i : ' 867 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 868 WRITE (numout,*) 869 WRITE (numout,*) ' dommsk: tmask for each level' 870 WRITE (numout,*) ' ----------------------------' 871 DO jk = 1, jpk 872 imsk(:,:) = INT( tmask(:,:,jk) ) 873 WRITE(numout,*) 874 WRITE(numout,*) ' level = ',jk 875 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 876 END DO 877 ENDIF 878 ! 879 CALL wrk_dealloc( jpi, jpj, imsk ) 880 ! 881 END SUBROUTINE dom_msk 882 390 883 !!====================================================================== 391 884 END MODULE domrea 885
Note: See TracChangeset
for help on using the changeset viewer.