- Timestamp:
- 2015-07-16T13:55:15+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC
- Files:
-
- 4 deleted
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r4990 r5602 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 -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r4990 r5602 245 245 tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity 246 246 ! 247 CALL eos ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 247 ! 248 CALL eos ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 249 CALL eos_rab( tsn, rab_n ) ! now local thermal/haline expension ratio at T-points 250 CALL bn2 ( tsn, rab_n, rn2 ) ! before Brunt-Vaisala frequency need for zdfmxl 251 252 rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl 248 253 CALL zdf_mxl( kt ) ! In any case, we need mxl 249 254 ! … … 259 264 fr_i(:,:) = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1) ! Sea-ice fraction 260 265 qsr (:,:) = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1) ! solar radiation 261 IF 266 IF( ln_dynrnf ) & 262 267 rnf (:,:) = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1) ! river runoffs 263 268 … … 383 388 384 389 ! 385 IF 390 IF( ln_dynrnf ) THEN 386 391 jf_rnf = jfld + 1 ; jfld = jf_rnf 387 392 slf_d(jf_rnf) = sn_rnf … … 535 540 !!--------------------------------------------------------------------- 536 541 #if defined key_ldfslp && ! defined key_c1d 542 CALL eos ( pts, rhd, rhop, gdept_0(:,:,:) ) 537 543 CALL eos_rab( pts, rab_n ) ! now local thermal/haline expension ratio at T-points 538 544 CALL bn2 ( pts, rab_n, rn2 ) ! now Brunt-Vaisala 539 IF( ln_zps ) & ! Partial steps: before Horizontal DErivative 540 & CALL zps_hde( kt, jpts, pts, gtsu, gtsv, & ! Partial steps: before horizontal gradient 541 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & ! 542 & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level 543 ! only gtsu, gtsv, rhd, gru , grv are used 544 545 546 ! ! of t, s, rd at the bottom ocean level 545 546 ! Partial steps: before Horizontal DErivative 547 IF( ln_zps .AND. .NOT. ln_isfcav) & 548 & CALL zps_hde ( kt, jpts, pts, gtsu, gtsv, & ! Partial steps: before horizontal gradient 549 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 550 IF( ln_zps .AND. ln_isfcav) & 551 & CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, & ! Partial steps for top cell (ISF) 552 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 553 & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the first ocean level 554 555 rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl 547 556 CALL zdf_mxl( kt ) ! mixed layer depth 548 557 CALL ldf_slp( kt, rhd, rn2 ) ! slopes -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
- Property svn:keywords set to Id
r4749 r5602 18 18 USE c1d ! 1D configuration 19 19 USE domcfg ! domain configuration (dom_cfg routine) 20 USE domain ! domain initialization 21 USE istate ! initial state setting (istate_init routine)20 USE domain ! domain initialization from coordinate & bathymetry (dom_init routine) 21 USE domrea ! domain initialization from mesh_mask (dom_init routine) 22 22 USE eosbn2 ! equation of state (eos bn2 routine) 23 23 ! ! ocean physics … … 34 34 USE trcstp ! passive tracer time-stepping (trc_stp routine) 35 35 USE dtadyn ! Lecture and interpolation of the dynamical fields 36 USE stpctl ! time stepping control (stp_ctl routine)37 36 ! ! I/O & MPP 38 37 USE iom ! I/O library … … 46 45 USE timing ! Timing 47 46 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 48 USE lbcnfd, ONLY: isendto, nsndto 47 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 49 48 50 49 USE trc … … 62 61 !!---------------------------------------------------------------------- 63 62 !! NEMO/OFF 3.3 , NEMO Consortium (2010) 64 !! $Id : nemogcm.F90 2528 2010-12-27 17:33:53Z rblod$63 !! $Id$ 65 64 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 66 65 !!---------------------------------------------------------------------- … … 95 94 istp = nit000 96 95 ! 97 CALL iom_init( "nemo") ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)96 CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 98 97 ! 99 98 DO WHILE ( istp <= nitend .AND. nstop == 0 ) ! time stepping … … 108 107 END DO 109 108 #if defined key_iomput 110 CALL iom_context_finalize( "nemo") ! needed for XIOS+AGRIF109 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 111 110 #endif 112 111 … … 143 142 INTEGER :: ilocal_comm ! local integer 144 143 INTEGER :: ios 144 LOGICAL :: llexist 145 145 CHARACTER(len=80), DIMENSION(16) :: cltxt 146 146 !! … … 149 149 & nn_bench, nn_timing 150 150 NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 151 & jpizoom, jpjzoom, jperio 151 & jpizoom, jpjzoom, jperio, ln_use_jattr 152 152 !!---------------------------------------------------------------------- 153 153 cltxt = '' 154 cxios_context = 'nemo' 154 155 ! 155 156 ! ! Open reference namelist and configuration namelist files … … 181 182 ! !--------------------------------------------! 182 183 #if defined key_iomput 183 CALL xios_initialize( " nemo",return_comm=ilocal_comm )184 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection184 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) 185 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 185 186 #else 186 187 ilocal_comm = 0 187 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)188 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 188 189 #endif 189 190 … … 233 234 WRITE(numout,*) ' NEMO team' 234 235 WRITE(numout,*) ' Ocean General Circulation Model' 235 WRITE(numout,*) ' version 3. 5 (2012) '236 WRITE(numout,*) ' version 3.6 (2015) ' 236 237 WRITE(numout,*) 237 238 WRITE(numout,*) … … 268 269 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 269 270 CALL dom_cfg ! Domain configuration 270 CALL dom_init ! Domain 271 ! 272 INQUIRE( FILE='coordinates.nc', EXIST = llexist ) ! Check if coordinate file exist 273 ! 274 IF( llexist ) THEN ; CALL dom_init ! compute the grid from coordinates and bathymetry 275 ELSE ; CALL dom_rea ! read grid from the meskmask 276 ENDIF 271 277 CALL istate_init ! ocean initial state (Dynamics and tracers) 272 278 … … 275 281 IF( ln_ctl ) CALL prt_ctl_init ! Print control 276 282 277 ! ! Ocean physics278 283 CALL sbc_init ! Forcings : surface module 284 279 285 #if ! defined key_degrad 280 286 CALL ldf_tra_init ! Lateral ocean tracer physics … … 282 288 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 283 289 284 ! ! Active tracers285 290 CALL tra_qsr_init ! penetrative solar radiation qsr 286 291 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 287 292 288 CALL trc_nam_run ! Needed to get restart parameters for passive tracers 289 IF( ln_rsttr ) THEN 290 neuler = 1 ! Set time-step indicator at nit000 (leap-frog) 291 CALL trc_rst_cal( nit000, 'READ' ) ! calendar 292 ELSE 293 neuler = 0 ! Set time-step indicator at nit000 (euler) 294 CALL day_init ! set calendar 295 ENDIF 296 ! ! Dynamics 293 CALL trc_nam_run ! Needed to get restart parameters for passive tracers 294 CALL trc_rst_cal( nit000, 'READ' ) ! calendar 297 295 CALL dta_dyn_init ! Initialization for the dynamics 298 296 299 ! ! Passive tracers300 297 CALL trc_init ! Passive tracers initialization 301 ! 302 ! Initialise diaptr as some variables are used in if statements later (in 303 ! various advection and diffusion routines. 304 CALL dia_ptr_init 305 ! 306 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 298 CALL dia_ptr_init ! Initialise diaptr as some variables are used 299 ! ! in various advection and diffusion routines 300 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 307 301 ! 308 302 IF( nn_timing == 1 ) CALL timing_stop( 'nemo_init') … … 359 353 WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 360 354 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio 355 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 361 356 ENDIF 362 357 ! ! Parameter control … … 594 589 !!---------------------------------------------------------------------- 595 590 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 596 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 591 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. 592 !Mocavero, CMCC) 597 593 !!---------------------------------------------------------------------- 598 594 … … 617 613 !loop over the other north-fold processes to find the processes 618 614 !managing the points belonging to the sxT-dxT range 619 DO jn = jpnij - jpni +1, jpnij 620 IF ( njmppt(jn) == njmppmax ) THEN615 616 DO jn = 1, jpni 621 617 !sxT is the first point (in the global domain) of the jn 622 618 !process 623 sxT = n imppt(jn)619 sxT = nfiimpp(jn, jpnj) 624 620 !dxT is the last point (in the global domain) of the jn 625 621 !process 626 dxT = n imppt(jn) + nlcit(jn) - 1622 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 627 623 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 628 624 nsndto = nsndto + 1 629 isendto(nsndto) = jn630 ELSEIF ((sxM .le. sxT) .AND. (dxM .g t. dxT)) THEN625 isendto(nsndto) = jn 626 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 631 627 nsndto = nsndto + 1 632 isendto(nsndto) = jn628 isendto(nsndto) = jn 633 629 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 634 630 nsndto = nsndto + 1 635 isendto(nsndto) = jn631 isendto(nsndto) = jn 636 632 END IF 637 END IF638 633 END DO 634 nfsloop = 1 635 nfeloop = nlci 636 DO jn = 2,jpni-1 637 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 638 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 639 nfsloop = nldi 640 ENDIF 641 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 642 nfeloop = nlei 643 ENDIF 644 ENDIF 645 END DO 646 639 647 ENDIF 640 648 l_north_nogather = .TRUE. 641 642 649 END SUBROUTINE nemo_northcomms 643 650 #else … … 646 653 END SUBROUTINE nemo_northcomms 647 654 #endif 655 656 SUBROUTINE istate_init 657 !!---------------------------------------------------------------------- 658 !! *** ROUTINE istate_init *** 659 !! 660 !! ** Purpose : Initialization to zero of the dynamics and tracers. 661 !!---------------------------------------------------------------------- 662 ! 663 ! now fields ! after fields ! 664 un (:,:,:) = 0._wp ; ua(:,:,:) = 0._wp ! 665 vn (:,:,:) = 0._wp ; va(:,:,:) = 0._wp ! 666 wn (:,:,:) = 0._wp ! ! 667 hdivn(:,:,:) = 0._wp ! ! 668 tsn (:,:,:,:) = 0._wp ! ! 669 ! 670 rhd (:,:,:) = 0.e0 671 rhop (:,:,:) = 0.e0 672 rn2 (:,:,:) = 0.e0 673 ! 674 END SUBROUTINE istate_init 675 676 SUBROUTINE stp_ctl( kt, kindic ) 677 !!---------------------------------------------------------------------- 678 !! *** ROUTINE stp_ctl *** 679 !! 680 !! ** Purpose : Control the run 681 !! 682 !! ** Method : - Save the time step in numstp 683 !! 684 !! ** Actions : 'time.step' file containing the last ocean time-step 685 !!---------------------------------------------------------------------- 686 INTEGER, INTENT(in ) :: kt ! ocean time-step index 687 INTEGER, INTENT(inout) :: kindic ! indicator of solver convergence 688 !!---------------------------------------------------------------------- 689 ! 690 IF( kt == nit000 .AND. lwp ) THEN 691 WRITE(numout,*) 692 WRITE(numout,*) 'stp_ctl : time-stepping control' 693 WRITE(numout,*) '~~~~~~~' 694 ! open time.step file 695 CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 696 ENDIF 697 ! 698 IF(lwp) WRITE ( numstp, '(1x, i8)' ) kt !* save the current time step in numstp 699 IF(lwp) REWIND( numstp ) ! -------------------------- 700 ! 701 END SUBROUTINE stp_ctl 648 702 !!====================================================================== 649 703 END MODULE nemogcm
Note: See TracChangeset
for help on using the changeset viewer.