- Timestamp:
- 2015-11-20T09:39:06+01:00 (8 years ago)
- Location:
- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC
- Files:
-
- 4 deleted
- 3 edited
-
domain.F90 (deleted)
-
dommsk.F90 (deleted)
-
domrea.F90 (modified) (6 diffs)
-
dtadyn.F90 (modified) (17 diffs)
-
istate.F90 (deleted)
-
nemogcm.F90 (modified) (19 diffs, 1 prop)
-
stpctl.F90 (deleted)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r5038 r5901 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 !! History : OPA ! 1990-10 (C. Levy - G. Madec) Original code 7 !! ! 1992-01 (M. Imbard) insert time step initialization 8 !! ! 1996-06 (G. Madec) generalized vertical coordinate 9 !! ! 1997-02 (G. Madec) creation of domwri.F 10 !! ! 2001-05 (E.Durand - G. Madec) insert closed sea 11 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 7 12 !!---------------------------------------------------------------------- 8 13 9 14 !!---------------------------------------------------------------------- 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 15 !! dom_init : initialize the space and time domain 16 !! dom_nam : read and contral domain namelists 17 !! dom_ctl : control print for the ocean domain 14 18 !!---------------------------------------------------------------------- 19 USE oce ! 20 USE trc_oce ! shared ocean/biogeochemical variables 15 21 USE dom_oce ! ocean space and time domain 16 USE dommsk ! domain: masks 22 USE phycst ! physical constants 23 USE domstp ! domain: set the time-step 24 ! 25 USE in_out_manager ! I/O manager 26 USE lib_mpp ! distributed memory computing library 17 27 USE lbclnk ! lateral boundary condition - MPP exchanges 18 USE trc_oce ! shared ocean/biogeochemical variables19 USE lib_mpp20 USE in_out_manager21 28 USE wrk_nemo 22 29 23 30 IMPLICIT NONE 24 31 PRIVATE 25 32 26 PUBLIC dom_rea ! routine called by inidom.F90 27 !! * Substitutions 33 PUBLIC dom_rea ! called by nemogcm.F90 34 35 !! * Substitutions 28 36 # include "domzgr_substitute.h90" 37 # include "vectopt_loop_substitute.h90" 29 38 !!---------------------------------------------------------------------- 30 !! NEMO/OFF 3. 3 , NEMO Consortium (2010)39 !! NEMO/OFF 3.7 , NEMO Consortium (2015) 31 40 !! $Id$ 32 !! Software governed by the CeCILL licence 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 42 !!---------------------------------------------------------------------- 34 43 CONTAINS … … 37 46 !!---------------------------------------------------------------------- 38 47 !! *** ROUTINE dom_rea *** 48 !! 49 !! ** Purpose : Domain initialization. Call the routines that are 50 !! required to create the arrays which define the space and time 51 !! domain of the ocean model. 52 !! 53 !! ** Method : 54 !! - dom_stp: defined the model time step 55 !! - dom_rea: read the meshmask file if nmsh=1 56 !!---------------------------------------------------------------------- 57 INTEGER :: jk ! dummy loop index 58 INTEGER :: iconf = 0 ! local integers 59 !!---------------------------------------------------------------------- 60 ! 61 IF(lwp) THEN 62 WRITE(numout,*) 63 WRITE(numout,*) 'dom_init : domain initialization' 64 WRITE(numout,*) '~~~~~~~~' 65 ENDIF 66 ! 67 CALL dom_nam ! read namelist ( namrun, namdom ) 68 CALL dom_zgr ! Vertical mesh and bathymetry option 69 CALL dom_grd ! Create a domain file 70 ! 71 ! ! associated horizontal metrics 72 ! 73 r1_e1t(:,:) = 1._wp / e1t(:,:) ; r1_e2t (:,:) = 1._wp / e2t(:,:) 74 r1_e1u(:,:) = 1._wp / e1u(:,:) ; r1_e2u (:,:) = 1._wp / e2u(:,:) 75 r1_e1v(:,:) = 1._wp / e1v(:,:) ; r1_e2v (:,:) = 1._wp / e2v(:,:) 76 r1_e1f(:,:) = 1._wp / e1f(:,:) ; r1_e2f (:,:) = 1._wp / e2f(:,:) 77 ! 78 e1e2t (:,:) = e1t(:,:) * e2t(:,:) ; r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 79 e1e2u (:,:) = e1u(:,:) * e2u(:,:) ; r1_e1e2u(:,:) = 1._wp / e1e2u(:,:) 80 e1e2v (:,:) = e1v(:,:) * e2v(:,:) ; r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 81 e1e2f (:,:) = e1f(:,:) * e2f(:,:) ; r1_e1e2f(:,:) = 1._wp / e1e2f(:,:) 82 ! 83 e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 84 e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 85 ! 86 hu(:,:) = 0._wp ! Ocean depth at U- and V-points 87 hv(:,:) = 0._wp 88 DO jk = 1, jpk 89 hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 90 hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 91 END DO 92 ! ! Inverse of the local depth 93 hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 94 hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 95 ! 96 CALL dom_stp ! Time step 97 CALL dom_msk ! Masks 98 CALL dom_ctl ! Domain control 99 ! 100 END SUBROUTINE dom_rea 101 102 103 SUBROUTINE dom_nam 104 !!---------------------------------------------------------------------- 105 !! *** ROUTINE dom_nam *** 106 !! 107 !! ** Purpose : read domaine namelists and print the variables. 108 !! 109 !! ** input : - namrun namelist 110 !! - namdom namelist 111 !!---------------------------------------------------------------------- 112 USE ioipsl 113 INTEGER :: ios ! Local integer output status for namelist read 114 ! 115 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, & 116 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, & 117 & nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , & 118 & nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler 119 NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh , rn_hmin, & 120 & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , & 121 & rn_rdtmax, rn_rdth , nn_baro , nn_closea , ln_crs, & 122 & jphgr_msh, & 123 & ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & 124 & ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 125 & ppa2, ppkth2, ppacr2 126 #if defined key_netcdf4 127 NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 128 #endif 129 !!---------------------------------------------------------------------- 130 131 REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run 132 READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 133 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp ) 134 135 REWIND( numnam_cfg ) ! Namelist namrun in configuration namelist : Parameters of the run 136 READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) 137 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp ) 138 IF(lwm) WRITE ( numond, namrun ) 139 ! 140 IF(lwp) THEN ! control print 141 WRITE(numout,*) 142 WRITE(numout,*) 'dom_nam : domain initialization through namelist read' 143 WRITE(numout,*) '~~~~~~~ ' 144 WRITE(numout,*) ' Namelist namrun' 145 WRITE(numout,*) ' job number nn_no = ', nn_no 146 WRITE(numout,*) ' experiment name for output cn_exp = ', cn_exp 147 WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart 148 WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl 149 WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000 150 WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend 151 WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0 152 WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy 153 WRITE(numout,*) ' initial state output nn_istate = ', nn_istate 154 WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock 155 WRITE(numout,*) ' frequency of output file nn_write = ', nn_write 156 WRITE(numout,*) ' multi file dimgout ln_dimgnnn = ', ln_dimgnnn 157 WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland 158 WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta 159 WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber 160 WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz 161 ENDIF 162 no = nn_no ! conversion DOCTOR names into model names (this should disappear soon) 163 cexper = cn_exp 164 nrstdt = nn_rstctl 165 nit000 = nn_it000 166 nitend = nn_itend 167 ndate0 = nn_date0 168 nleapy = nn_leapy 169 ninist = nn_istate 170 nstock = nn_stock 171 nstocklist = nn_stocklist 172 nwrite = nn_write 173 ! 174 ! ! control of output frequency 175 IF ( nstock == 0 .OR. nstock > nitend ) THEN 176 WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend 177 CALL ctl_warn( ctmp1 ) 178 nstock = nitend 179 ENDIF 180 IF ( nwrite == 0 ) THEN 181 WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend 182 CALL ctl_warn( ctmp1 ) 183 nwrite = nitend 184 ENDIF 185 186 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 187 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 188 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 189 190 #if defined key_agrif 191 IF( Agrif_Root() ) THEN 192 #endif 193 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 194 CASE ( 1 ) 195 CALL ioconf_calendar('gregorian') 196 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year' 197 CASE ( 0 ) 198 CALL ioconf_calendar('noleap') 199 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year' 200 CASE ( 30 ) 201 CALL ioconf_calendar('360d') 202 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year' 203 END SELECT 204 #if defined key_agrif 205 ENDIF 206 #endif 207 208 REWIND( numnam_ref ) ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep) 209 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 210 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 211 212 REWIND( numnam_cfg ) ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 213 READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 214 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 215 IF(lwm) WRITE ( numond, namdom ) 216 217 IF(lwp) THEN 218 WRITE(numout,*) 219 WRITE(numout,*) ' Namelist namdom : space & time domain' 220 WRITE(numout,*) ' flag read/compute bathymetry nn_bathy = ', nn_bathy 221 WRITE(numout,*) ' Depth (if =0 bathy=jpkm1) rn_bathy = ', rn_bathy 222 WRITE(numout,*) ' min depth of the ocean (>0) or rn_hmin = ', rn_hmin 223 WRITE(numout,*) ' minimum thickness of partial rn_e3zps_min = ', rn_e3zps_min, ' (m)' 224 WRITE(numout,*) ' step level rn_e3zps_rat = ', rn_e3zps_rat 225 WRITE(numout,*) ' create mesh/mask file(s) nn_msh = ', nn_msh 226 WRITE(numout,*) ' = 0 no file created ' 227 WRITE(numout,*) ' = 1 mesh_mask ' 228 WRITE(numout,*) ' = 2 mesh and mask ' 229 WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask ' 230 WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt 231 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 232 WRITE(numout,*) ' time-splitting: nb of sub time-step nn_baro = ', nn_baro 233 WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc 234 WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin 235 WRITE(numout,*) ' bottom tracer rdt rdtmax = ', rn_rdtmax 236 WRITE(numout,*) ' depth of transition rn_rdth = ', rn_rdth 237 WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea 238 WRITE(numout,*) ' type of horizontal mesh jphgr_msh = ', jphgr_msh 239 WRITE(numout,*) ' longitude of first raw and column T-point ppglam0 = ', ppglam0 240 WRITE(numout,*) ' latitude of first raw and column T-point ppgphi0 = ', ppgphi0 241 WRITE(numout,*) ' zonal grid-spacing (degrees) ppe1_deg = ', ppe1_deg 242 WRITE(numout,*) ' meridional grid-spacing (degrees) ppe2_deg = ', ppe2_deg 243 WRITE(numout,*) ' zonal grid-spacing (degrees) ppe1_m = ', ppe1_m 244 WRITE(numout,*) ' meridional grid-spacing (degrees) ppe2_m = ', ppe2_m 245 WRITE(numout,*) ' ORCA r4, r2 and r05 coefficients ppsur = ', ppsur 246 WRITE(numout,*) ' ppa0 = ', ppa0 247 WRITE(numout,*) ' ppa1 = ', ppa1 248 WRITE(numout,*) ' ppkth = ', ppkth 249 WRITE(numout,*) ' ppacr = ', ppacr 250 WRITE(numout,*) ' Minimum vertical spacing ppdzmin = ', ppdzmin 251 WRITE(numout,*) ' Maximum depth pphmax = ', pphmax 252 WRITE(numout,*) ' Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh 253 WRITE(numout,*) ' Double tanh function parameters ppa2 = ', ppa2 254 WRITE(numout,*) ' ppkth2 = ', ppkth2 255 WRITE(numout,*) ' ppacr2 = ', ppacr2 256 ENDIF 257 258 ntopo = nn_bathy ! conversion DOCTOR names into model names (this should disappear soon) 259 e3zps_min = rn_e3zps_min 260 e3zps_rat = rn_e3zps_rat 261 nmsh = nn_msh 262 nacc = nn_acc 263 atfp = rn_atfp 264 rdt = rn_rdt 265 rdtmin = rn_rdtmin 266 rdtmax = rn_rdtmin 267 rdth = rn_rdth 268 269 #if defined key_netcdf4 270 ! ! NetCDF 4 case ("key_netcdf4" defined) 271 REWIND( numnam_ref ) ! Namelist namnc4 in reference namelist : NETCDF 272 READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 273 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp ) 274 275 REWIND( numnam_cfg ) ! Namelist namnc4 in configuration namelist : NETCDF 276 READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 ) 277 908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp ) 278 IF(lwm) WRITE( numond, namnc4 ) 279 IF(lwp) THEN ! control print 280 WRITE(numout,*) 281 WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters' 282 WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i 283 WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j 284 WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k 285 WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip 286 ENDIF 287 288 ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module) 289 ! Note the chunk size in the unlimited (time) dimension will be fixed at 1 290 snc4set%ni = nn_nchunks_i 291 snc4set%nj = nn_nchunks_j 292 snc4set%nk = nn_nchunks_k 293 snc4set%luse = ln_nc4zip 294 #else 295 snc4set%luse = .FALSE. ! No NetCDF 4 case 296 #endif 297 ! 298 END SUBROUTINE dom_nam 299 300 301 SUBROUTINE dom_zgr 302 !!---------------------------------------------------------------------- 303 !! *** ROUTINE dom_zgr *** 304 !! 305 !! ** Purpose : set the depth of model levels and the resulting 306 !! vertical scale factors. 307 !! 308 !! ** Method : - reference 1D vertical coordinate (gdep._1d, e3._1d) 309 !! - read/set ocean depth and ocean levels (bathy, mbathy) 310 !! - vertical coordinate (gdep., e3.) depending on the 311 !! coordinate chosen : 312 !! ln_zco=T z-coordinate 313 !! ln_zps=T z-coordinate with partial steps 314 !! ln_zco=T s-coordinate 315 !! 316 !! ** Action : define gdep., e3., mbathy and bathy 317 !!---------------------------------------------------------------------- 318 INTEGER :: ioptio = 0 ! temporary integer 319 INTEGER :: ios 320 !! 321 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 322 !!---------------------------------------------------------------------- 323 324 REWIND( numnam_ref ) ! Namelist namzgr in reference namelist : Vertical coordinate 325 READ ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 ) 326 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp ) 327 328 REWIND( numnam_cfg ) ! Namelist namzgr in configuration namelist : Vertical coordinate 329 READ ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 ) 330 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp ) 331 IF(lwm) WRITE ( numond, namzgr ) 332 333 IF(lwp) THEN ! Control print 334 WRITE(numout,*) 335 WRITE(numout,*) 'dom_zgr : vertical coordinate' 336 WRITE(numout,*) '~~~~~~~' 337 WRITE(numout,*) ' Namelist namzgr : set vertical coordinate' 338 WRITE(numout,*) ' z-coordinate - full steps ln_zco = ', ln_zco 339 WRITE(numout,*) ' z-coordinate - partial steps ln_zps = ', ln_zps 340 WRITE(numout,*) ' s- or hybrid z-s-coordinate ln_sco = ', ln_sco 341 WRITE(numout,*) ' ice shelf cavity ln_isfcav = ', ln_isfcav 342 ENDIF 343 344 ioptio = 0 ! Check Vertical coordinate options 345 IF( ln_zco ) ioptio = ioptio + 1 346 IF( ln_zps ) ioptio = ioptio + 1 347 IF( ln_sco ) ioptio = ioptio + 1 348 IF( ln_isfcav ) ioptio = 33 349 IF ( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' ) 350 IF ( ioptio == 33 ) CALL ctl_stop( ' isf cavity with off line module not yet done ' ) 351 352 END SUBROUTINE dom_zgr 353 354 355 SUBROUTINE dom_ctl 356 !!---------------------------------------------------------------------- 357 !! *** ROUTINE dom_ctl *** 358 !! 359 !! ** Purpose : Domain control. 360 !! 361 !! ** Method : compute and print extrema of masked scale factors 362 !! 363 !!---------------------------------------------------------------------- 364 INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 365 INTEGER, DIMENSION(2) :: iloc ! 366 REAL(wp) :: ze1min, ze1max, ze2min, ze2max 367 !!---------------------------------------------------------------------- 368 369 ! Extrema of the scale factors 370 371 IF(lwp)WRITE(numout,*) 372 IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 373 IF(lwp)WRITE(numout,*) '~~~~~~~' 374 375 IF (lk_mpp) THEN 376 CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 ) 377 CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 ) 378 CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 ) 379 CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 ) 380 ELSE 381 ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 382 ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 383 ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 384 ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 385 386 iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 387 iimi1 = iloc(1) + nimpp - 1 388 ijmi1 = iloc(2) + njmpp - 1 389 iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 390 iimi2 = iloc(1) + nimpp - 1 391 ijmi2 = iloc(2) + njmpp - 1 392 iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 393 iima1 = iloc(1) + nimpp - 1 394 ijma1 = iloc(2) + njmpp - 1 395 iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 396 iima2 = iloc(1) + nimpp - 1 397 ijma2 = iloc(2) + njmpp - 1 398 ENDIF 399 ! 400 IF(lwp) THEN 401 WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1 402 WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1 403 WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2 404 WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2 405 ENDIF 406 ! 407 END SUBROUTINE dom_ctl 408 409 410 SUBROUTINE dom_grd 411 !!---------------------------------------------------------------------- 412 !! *** ROUTINE dom_grd *** 39 413 !! 40 414 !! ** Purpose : Read the NetCDF file(s) which contain(s) all the … … 141 515 CALL iom_get( inum2, jpdom_data, 'facvolt', facvol ) 142 516 #endif 143 144 517 ! ! horizontal mesh (inum3) 145 518 CALL iom_get( inum3, jpdom_data, 'glamt', glamt ) … … 344 717 CALL wrk_dealloc( jpi, jpj, zmbk, zprt, zprw ) 345 718 ! 346 END SUBROUTINE dom_ rea719 END SUBROUTINE dom_grd 347 720 348 721 … … 359 732 !! (min value = 1 over land) 360 733 !!---------------------------------------------------------------------- 361 !362 734 INTEGER :: ji, jj ! dummy loop indices 363 735 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk … … 388 760 END SUBROUTINE zgr_bot_level 389 761 762 763 SUBROUTINE dom_msk 764 !!--------------------------------------------------------------------- 765 !! *** ROUTINE dom_msk *** 766 !! 767 !! ** Purpose : Off-line case: defines the interior domain T-mask. 768 !! 769 !! ** Method : The interior ocean/land mask is computed from tmask 770 !! setting to zero the duplicated row and lines due to 771 !! MPP exchange halos, est-west cyclic and north fold 772 !! boundary conditions. 773 !! 774 !! ** Action : tmask_i : interiorland/ocean mask at t-point 775 !! tpol : ??? 776 !!---------------------------------------------------------------------- 777 INTEGER :: ji, jj, jk ! dummy loop indices 778 INTEGER :: iif, iil, ijf, ijl ! local integers 779 INTEGER, POINTER, DIMENSION(:,:) :: imsk 780 !!--------------------------------------------------------------------- 781 782 CALL wrk_alloc( jpi, jpj, imsk ) 783 ! 784 ! Interior domain mask (used for global sum) 785 ! -------------------- 786 ssmask(:,:) = tmask(:,:,1) 787 tmask_i(:,:) = tmask(:,:,1) 788 iif = jpreci ! thickness of exchange halos in i-axis 789 iil = nlci - jpreci + 1 790 ijf = jprecj ! thickness of exchange halos in j-axis 791 ijl = nlcj - jprecj + 1 792 ! 793 tmask_i( 1 :iif, : ) = 0._wp ! first columns 794 tmask_i(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns) 795 tmask_i( : , 1 :ijf) = 0._wp ! first rows 796 tmask_i( : ,ijl:jpj) = 0._wp ! last rows (including mpp extra rows) 797 ! 798 ! ! north fold mask 799 tpol(1:jpiglo) = 1._wp 800 ! 801 IF( jperio == 3 .OR. jperio == 4 ) tpol(jpiglo/2+1:jpiglo) = 0._wp ! T-point pivot 802 IF( jperio == 5 .OR. jperio == 6 ) tpol( 1 :jpiglo) = 0._wp ! F-point pivot 803 IF( jperio == 3 .OR. jperio == 4 ) THEN ! T-point pivot: only half of the nlcj-1 row 804 IF( mjg(ijl-1) == jpjglo-1 ) THEN 805 DO ji = iif+1, iil-1 806 tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji)) 807 END DO 808 ENDIF 809 ENDIF 810 ! 811 ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at 812 ! least 1 wet u point 813 DO jj = 1, jpjm1 814 DO ji = 1, fs_jpim1 ! vector loop 815 umask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji+1,jj ) * MIN(1._wp,SUM(umask(ji,jj,:))) 816 vmask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji ,jj+1) * MIN(1._wp,SUM(vmask(ji,jj,:))) 817 END DO 818 DO ji = 1, jpim1 ! NO vector opt. 819 fmask_i(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) & 820 & * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 821 END DO 822 END DO 823 CALL lbc_lnk( umask_i, 'U', 1._wp ) ! Lateral boundary conditions 824 CALL lbc_lnk( vmask_i, 'V', 1._wp ) 825 CALL lbc_lnk( fmask_i, 'F', 1._wp ) 826 827 ! 3. Ocean/land mask at wu-, wv- and w points 828 !---------------------------------------------- 829 wmask (:,:,1) = tmask(:,:,1) ! surface value 830 wumask(:,:,1) = umask(:,:,1) 831 wvmask(:,:,1) = vmask(:,:,1) 832 DO jk = 2, jpk ! deeper value 833 wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 834 wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1) 835 wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 836 END DO 837 ! 838 IF( nprint == 1 .AND. lwp ) THEN ! Control print 839 imsk(:,:) = INT( tmask_i(:,:) ) 840 WRITE(numout,*) ' tmask_i : ' 841 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 842 WRITE (numout,*) 843 WRITE (numout,*) ' dommsk: tmask for each level' 844 WRITE (numout,*) ' ----------------------------' 845 DO jk = 1, jpk 846 imsk(:,:) = INT( tmask(:,:,jk) ) 847 WRITE(numout,*) 848 WRITE(numout,*) ' level = ',jk 849 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 850 END DO 851 ENDIF 852 ! 853 CALL wrk_dealloc( jpi, jpj, imsk ) 854 ! 855 END SUBROUTINE dom_msk 856 390 857 !!====================================================================== 391 858 END MODULE domrea 859 -
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r5038 r5901 26 26 USE trc_oce ! share ocean/biogeo variables 27 27 USE phycst ! physical constants 28 USE ldftra ! lateral diffusivity coefficients 28 29 USE trabbl ! active tracer: bottom boundary layer 29 30 USE ldfslp ! lateral diffusion: iso-neutral slopes 30 USE ldfeiv ! eddy induced velocity coef.31 USE ldftra_oce ! ocean tracer lateral physics32 31 USE zdfmxl ! vertical physics: mixed layer depth 33 32 USE eosbn2 ! equation of state - Brunt Vaisala frequency … … 40 39 USE fldread ! read input fields 41 40 USE timing ! Timing 41 USE wrk_nemo 42 42 43 43 IMPLICIT NONE … … 50 50 LOGICAL :: ln_dynwzv !: vertical velocity read in a file (T) or computed from u/v (F) 51 51 LOGICAL :: ln_dynbbl !: bbl coef read in a file (T) or computed (F) 52 LOGICAL :: ln_degrad !: degradation option enabled or not53 52 LOGICAL :: ln_dynrnf !: read runoff data in file (T) or set to zero (F) 54 53 55 INTEGER , PARAMETER :: jpfld = 21! maximum number of fields to read54 INTEGER , PARAMETER :: jpfld = 15 ! maximum number of fields to read 56 55 INTEGER , SAVE :: jf_tem ! index of temperature 57 56 INTEGER , SAVE :: jf_sal ! index of salinity … … 68 67 INTEGER , SAVE :: jf_ubl ! index of u-bbl coef 69 68 INTEGER , SAVE :: jf_vbl ! index of v-bbl coef 70 INTEGER , SAVE :: jf_ahu ! index of u-diffusivity coef71 INTEGER , SAVE :: jf_ahv ! index of v-diffusivity coef72 INTEGER , SAVE :: jf_ahw ! index of w-diffusivity coef73 INTEGER , SAVE :: jf_eiu ! index of u-eiv74 INTEGER , SAVE :: jf_eiv ! index of v-eiv75 INTEGER , SAVE :: jf_eiw ! index of w-eiv76 69 INTEGER , SAVE :: jf_fmf ! index of downward salt flux 77 70 … … 112 105 !! - interpolates data if needed 113 106 !!---------------------------------------------------------------------- 114 ! 115 USE oce, ONLY: zts => tsa 107 USE oce, ONLY: zts => tsa 116 108 USE oce, ONLY: zuslp => ua , zvslp => va 117 USE oce, ONLY: zwslpi => rotb , zwslpj => rotn118 USE oce, ONLY: zu => ub , zv => vb, zw => hdivb109 USE oce, ONLY: zwslpi => ua_sv , zwslpj => va_sv 110 USE oce, ONLY: zu => ub , zv => vb, zw => rke 119 111 ! 120 112 INTEGER, INTENT(in) :: kt ! ocean time-step index 113 ! 114 ! REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts 115 ! REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zuslp, zvslp, zwslpi, zwslpj 116 ! REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zu, zv, zw 117 ! 121 118 ! 122 119 INTEGER :: ji, jj ! dummy loop indices … … 138 135 CALL fld_read( kt, 1, sf_dyn ) !== read data at kt time step ==! 139 136 ! 140 IF( l k_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace)137 IF( l_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace) 141 138 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:) ! temperature 142 139 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:) ! salinity … … 162 159 ENDIF 163 160 ! 164 IF( l k_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace)161 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace) 165 162 iswap_tem = 0 166 163 IF( kt /= nit000 .AND. ( sf_dyn(jf_tem)%nrec_a(2) - nrecprev_tem ) /= 0 ) iswap_tem = 1 … … 245 242 tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity 246 243 ! 247 CALL eos ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 244 ! 245 CALL eos ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 246 CALL eos_rab( tsn, rab_n ) ! now local thermal/haline expension ratio at T-points 247 CALL bn2 ( tsn, rab_n, rn2 ) ! before Brunt-Vaisala frequency need for zdfmxl 248 249 rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl 248 250 CALL zdf_mxl( kt ) ! In any case, we need mxl 249 251 ! … … 259 261 fr_i(:,:) = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1) ! Sea-ice fraction 260 262 qsr (:,:) = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1) ! solar radiation 261 IF 263 IF( ln_dynrnf ) & 262 264 rnf (:,:) = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1) ! river runoffs 263 265 266 ! ! update eddy diffusivity coeff. and/or eiv coeff. at kt 267 IF( l_ldftra_time .OR. l_ldfeiv_time ) CALL ldf_tra( kt ) 264 268 ! ! bbl diffusive coef 265 269 #if defined key_trabbl && ! defined key_c1d … … 271 275 CALL bbl( kt, nit000, 'TRC') 272 276 END IF 273 #endif274 #if ( ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv ) && ! defined key_c1d275 aeiw(:,:) = sf_dyn(jf_eiw)%fnow(:,:,1) * tmask(:,:,1) ! w-eiv276 ! ! Computes the horizontal values from the vertical value277 DO jj = 2, jpjm1278 DO ji = fs_2, fs_jpim1 ! vector opt.279 aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj ) ) ! Average the diffusive coefficient at u- v- points280 aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji ,jj+1) ) ! at u- v- points281 END DO282 END DO283 CALL lbc_lnk( aeiu, 'U', 1. ) ; CALL lbc_lnk( aeiv, 'V', 1. ) ! lateral boundary condition284 #endif285 286 #if defined key_degrad && ! defined key_c1d287 ! ! degrad option : diffusive and eiv coef are 3D288 ahtu(:,:,:) = sf_dyn(jf_ahu)%fnow(:,:,:) * umask(:,:,:)289 ahtv(:,:,:) = sf_dyn(jf_ahv)%fnow(:,:,:) * vmask(:,:,:)290 ahtw(:,:,:) = sf_dyn(jf_ahw)%fnow(:,:,:) * tmask(:,:,:)291 # if defined key_traldf_eiv292 aeiu(:,:,:) = sf_dyn(jf_eiu)%fnow(:,:,:) * umask(:,:,:)293 aeiv(:,:,:) = sf_dyn(jf_eiv)%fnow(:,:,:) * vmask(:,:,:)294 aeiw(:,:,:) = sf_dyn(jf_eiw)%fnow(:,:,:) * tmask(:,:,:)295 # endif296 277 #endif 297 278 ! … … 334 315 TYPE(FLD_N), DIMENSION(jpfld) :: slf_d ! array of namelist informations on the fields to read 335 316 TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf ! informations about the fields to be read 336 TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl ! " " 337 TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf ! " " 338 !!---------------------------------------------------------------------- 339 ! 340 NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad, ln_dynrnf, & 317 TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, sn_fmf ! " " 318 NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_dynrnf, & 341 319 & sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf, & 342 & sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, &343 & sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf320 & sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, sn_fmf 321 !!---------------------------------------------------------------------- 344 322 ! 345 323 REWIND( numnam_ref ) ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data … … 360 338 WRITE(numout,*) ' vertical velocity read from file (T) or computed (F) ln_dynwzv = ', ln_dynwzv 361 339 WRITE(numout,*) ' bbl coef read from file (T) or computed (F) ln_dynbbl = ', ln_dynbbl 362 WRITE(numout,*) ' degradation option enabled (T) or not (F) ln_degrad = ', ln_degrad363 340 WRITE(numout,*) ' river runoff option enabled (T) or not (F) ln_dynrnf = ', ln_dynrnf 364 341 WRITE(numout,*) 365 342 ENDIF 366 343 ! 367 IF( ln_degrad .AND. .NOT.lk_degrad ) THEN368 CALL ctl_warn( 'dta_dyn_init: degradation option requires key_degrad activated ; force ln_degrad to false' )369 ln_degrad = .FALSE.370 ENDIF371 344 IF( ln_dynbbl .AND. ( .NOT.lk_trabbl .OR. lk_c1d ) ) THEN 372 345 CALL ctl_warn( 'dta_dyn_init: bbl option requires key_trabbl activated ; force ln_dynbbl to false' ) … … 383 356 384 357 ! 385 IF 358 IF( ln_dynrnf ) THEN 386 359 jf_rnf = jfld + 1 ; jfld = jf_rnf 387 360 slf_d(jf_rnf) = sn_rnf … … 390 363 ENDIF 391 364 392 ! 393 IF( .NOT.ln_degrad ) THEN ! no degrad option 394 IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN ! eiv & bbl 395 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; jf_eiw = jfld + 3 ; jfld = jf_eiw 396 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl ; slf_d(jf_eiw) = sn_eiw 397 ENDIF 398 IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN ! no eiv & bbl 365 IF( ln_dynbbl ) THEN ! eiv & bbl 399 366 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; jfld = jf_vbl 400 367 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 401 ENDIF 402 IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN ! eiv & no bbl 403 jf_eiw = jfld + 1 ; jfld = jf_eiw ; slf_d(jf_eiw) = sn_eiw 404 ENDIF 405 ELSE 406 jf_ahu = jfld + 1 ; jf_ahv = jfld + 2 ; jf_ahw = jfld + 3 ; jfld = jf_ahw 407 slf_d(jf_ahu) = sn_ahu ; slf_d(jf_ahv) = sn_ahv ; slf_d(jf_ahw) = sn_ahw 408 IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN ! eiv & bbl 409 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; 410 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 411 jf_eiu = jfld + 3 ; jf_eiv = jfld + 4 ; jf_eiw = jfld + 5 ; jfld = jf_eiw 412 slf_d(jf_eiu) = sn_eiu ; slf_d(jf_eiv) = sn_eiv ; slf_d(jf_eiw) = sn_eiw 413 ENDIF 414 IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN ! no eiv & bbl 415 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; jfld = jf_vbl 416 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 417 ENDIF 418 IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN ! eiv & no bbl 419 jf_eiu = jfld + 1 ; jf_eiv = jfld + 2 ; jf_eiw = jfld + 3 ; jfld = jf_eiw 420 slf_d(jf_eiu) = sn_eiu ; slf_d(jf_eiv) = sn_eiv ; slf_d(jf_eiw) = sn_eiw 421 ENDIF 422 ENDIF 423 368 ENDIF 369 370 424 371 ALLOCATE( sf_dyn(jfld), STAT=ierr ) ! set sf structure 425 372 IF( ierr > 0 ) THEN 426 373 CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' ) ; RETURN 427 374 ENDIF 375 ! ! fill sf with slf_i and control print 376 CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 428 377 ! Open file for each variable to get his number of dimension 429 378 DO ifpr = 1, jfld 430 CALL iom_open( TRIM( cn_dir )//TRIM( slf_d(ifpr)%clname ), inum ) 431 idv = iom_varid( inum , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar 432 idimv = iom_file ( inum )%ndims(idv) ! number of dimension for variable sdjf%clvar 433 IF( inum /= 0 ) CALL iom_close( inum ) ! close file if already open 379 CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday ) 380 idv = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar 381 idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv) ! number of dimension for variable sdjf%clvar 382 IF( sf_dyn(ifpr)%num /= 0 ) CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open 383 ierr1=0 434 384 IF( idimv == 3 ) THEN ! 2D variable 435 385 ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 ) … … 443 393 ENDIF 444 394 END DO 445 ! ! fill sf with slf_i and control print 446 CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 447 ! 448 IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN ! slopes 395 ! 396 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! slopes 449 397 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! time interpolation 450 398 ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2), & … … 505 453 zv = pv(ji ,jj ,jk) * vmask(ji ,jj ,jk) * e1v(ji ,jj ) * fse3v(ji ,jj ,jk) 506 454 zv1 = pv(ji ,jj-1,jk) * vmask(ji ,jj-1,jk) * e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk) 507 zet = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )455 zet = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 508 456 zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet 509 457 END DO 510 458 END DO 511 459 END DO 460 ! ! update the horizontal divergence with the runoff inflow 461 IF( ln_dynrnf ) zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / fse3t(:,:,1) 462 ! 512 463 CALL lbc_lnk( zhdiv, 'T', 1. ) ! Lateral boundary conditions on zhdiv 513 !514 464 ! computation of vertical velocity from the bottom 515 465 pw(:,:,jpk) = 0._wp … … 534 484 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pwslpj ! meridional diapycnal slopes 535 485 !!--------------------------------------------------------------------- 536 #if defined key_ldfslp && ! defined key_c1d 537 CALL eos_rab( pts, rab_n ) ! now local thermal/haline expension ratio at T-points 538 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 547 CALL zdf_mxl( kt ) ! mixed layer depth 548 CALL ldf_slp( kt, rhd, rn2 ) ! slopes 549 puslp (:,:,:) = uslp (:,:,:) 550 pvslp (:,:,:) = vslp (:,:,:) 551 pwslpi(:,:,:) = wslpi(:,:,:) 552 pwslpj(:,:,:) = wslpj(:,:,:) 553 #else 554 puslp (:,:,:) = 0. ! to avoid warning when compiling 555 pvslp (:,:,:) = 0. 556 pwslpi(:,:,:) = 0. 557 pwslpj(:,:,:) = 0. 558 #endif 486 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace) 487 CALL eos ( pts, rhd, rhop, gdept_0(:,:,:) ) 488 CALL eos_rab( pts, rab_n ) ! now local thermal/haline expension ratio at T-points 489 CALL bn2 ( pts, rab_n, rn2 ) ! now Brunt-Vaisala 490 491 ! Partial steps: before Horizontal DErivative 492 IF( ln_zps .AND. .NOT. ln_isfcav) & 493 & CALL zps_hde ( kt, jpts, pts, gtsu, gtsv, & ! Partial steps: before horizontal gradient 494 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 495 IF( ln_zps .AND. ln_isfcav) & 496 & CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, & ! Partial steps for top cell (ISF) 497 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 498 & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the first ocean level 499 500 rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl 501 CALL zdf_mxl( kt ) ! mixed layer depth 502 CALL ldf_slp( kt, rhd, rn2 ) ! slopes 503 puslp (:,:,:) = uslp (:,:,:) 504 pvslp (:,:,:) = vslp (:,:,:) 505 pwslpi(:,:,:) = wslpi(:,:,:) 506 pwslpj(:,:,:) = wslpj(:,:,:) 507 ELSE 508 puslp (:,:,:) = 0. ! to avoid warning when compiling 509 pvslp (:,:,:) = 0. 510 pwslpi(:,:,:) = 0. 511 pwslpj(:,:,:) = 0. 512 ENDIF 559 513 ! 560 514 END SUBROUTINE dta_dyn_slp -
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
- Property svn:keywords set to Id
r5038 r5901 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 … … 26 26 USE traqsr ! solar radiation penetration (tra_qsr_init routine) 27 27 USE trabbl ! bottom boundary layer (tra_bbl_init routine) 28 USE traldf ! lateral physics (tra_ldf_init routine) 28 29 USE zdfini ! vertical physics: initialization 29 30 USE sbcmod ! surface boundary condition (sbc_init routine) … … 34 35 USE trcstp ! passive tracer time-stepping (trc_stp routine) 35 36 USE dtadyn ! Lecture and interpolation of the dynamical fields 36 USE stpctl ! time stepping control (stp_ctl routine)37 37 ! ! I/O & MPP 38 38 USE iom ! I/O library … … 46 46 USE timing ! Timing 47 47 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 48 USE lbcnfd, ONLY: isendto, nsndto 48 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 49 49 50 50 USE trc … … 62 62 !!---------------------------------------------------------------------- 63 63 !! NEMO/OFF 3.3 , NEMO Consortium (2010) 64 !! $Id : nemogcm.F90 2528 2010-12-27 17:33:53Z rblod$64 !! $Id$ 65 65 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 66 66 !!---------------------------------------------------------------------- … … 95 95 istp = nit000 96 96 ! 97 CALL iom_init( "nemo") ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)97 CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 98 98 ! 99 99 DO WHILE ( istp <= nitend .AND. nstop == 0 ) ! time stepping … … 108 108 END DO 109 109 #if defined key_iomput 110 CALL iom_context_finalize( "nemo") ! needed for XIOS+AGRIF110 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 111 111 #endif 112 112 … … 143 143 INTEGER :: ilocal_comm ! local integer 144 144 INTEGER :: ios 145 LOGICAL :: llexist 145 146 CHARACTER(len=80), DIMENSION(16) :: cltxt 146 147 !! … … 149 150 & nn_bench, nn_timing 150 151 NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 151 & jpizoom, jpjzoom, jperio 152 & jpizoom, jpjzoom, jperio, ln_use_jattr 152 153 !!---------------------------------------------------------------------- 153 154 cltxt = '' 155 cxios_context = 'nemo' 154 156 ! 155 157 ! ! Open reference namelist and configuration namelist files … … 181 183 ! !--------------------------------------------! 182 184 #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 selection185 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) 186 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 185 187 #else 186 188 ilocal_comm = 0 187 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)189 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 188 190 #endif 189 191 … … 233 235 WRITE(numout,*) ' NEMO team' 234 236 WRITE(numout,*) ' Ocean General Circulation Model' 235 WRITE(numout,*) ' version 3. 5 (2012) '237 WRITE(numout,*) ' version 3.6 (2015) ' 236 238 WRITE(numout,*) 237 239 WRITE(numout,*) … … 268 270 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 269 271 CALL dom_cfg ! Domain configuration 270 CALL dom_init ! Domain 272 ! 273 INQUIRE( FILE='coordinates.nc', EXIST = llexist ) ! Check if coordinate file exist 274 ! 275 IF( llexist ) THEN ; CALL dom_init ! compute the grid from coordinates and bathymetry 276 ELSE ; CALL dom_rea ! read grid from the meskmask 277 ENDIF 271 278 CALL istate_init ! ocean initial state (Dynamics and tracers) 272 279 … … 275 282 IF( ln_ctl ) CALL prt_ctl_init ! Print control 276 283 277 ! ! Ocean physics278 284 CALL sbc_init ! Forcings : surface module 279 #if ! defined key_degrad 285 280 286 CALL ldf_tra_init ! Lateral ocean tracer physics 281 #endif 282 IF( lk_ldfslp ) CALL ldf_slp_init ! slope oflateral mixing283 284 ! ! Active tracers 287 CALL ldf_eiv_init ! Eddy induced velocity param 288 CALL tra_ldf_init ! lateral mixing 289 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 290 285 291 CALL tra_qsr_init ! penetrative solar radiation qsr 286 292 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 287 293 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 294 CALL trc_nam_run ! Needed to get restart parameters for passive tracers 295 CALL trc_rst_cal( nit000, 'READ' ) ! calendar 297 296 CALL dta_dyn_init ! Initialization for the dynamics 298 297 299 ! ! Passive tracers300 298 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 299 CALL dia_ptr_init ! Initialise diaptr as some variables are used 300 ! ! in various advection and diffusion routines 301 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 307 302 ! 308 303 IF( nn_timing == 1 ) CALL timing_stop( 'nemo_init') … … 359 354 WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 360 355 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio 356 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 361 357 ENDIF 362 358 ! ! Parameter control … … 449 445 USE dom_oce, ONLY: dom_oce_alloc 450 446 USE zdf_oce, ONLY: zdf_oce_alloc 451 USE ldftra_oce, ONLY: ldftra_oce_alloc452 447 USE trc_oce, ONLY: trc_oce_alloc 453 448 ! … … 458 453 ierr = ierr + dia_wri_alloc () 459 454 ierr = ierr + dom_oce_alloc () ! ocean domain 460 ierr = ierr + ldftra_oce_alloc() ! ocean lateral physics : tracers461 455 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 462 456 ! … … 594 588 !!---------------------------------------------------------------------- 595 589 !! 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) 590 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. 591 !Mocavero, CMCC) 597 592 !!---------------------------------------------------------------------- 598 593 … … 617 612 !loop over the other north-fold processes to find the processes 618 613 !managing the points belonging to the sxT-dxT range 619 DO jn = jpnij - jpni +1, jpnij 620 IF ( njmppt(jn) == njmppmax ) THEN614 615 DO jn = 1, jpni 621 616 !sxT is the first point (in the global domain) of the jn 622 617 !process 623 sxT = n imppt(jn)618 sxT = nfiimpp(jn, jpnj) 624 619 !dxT is the last point (in the global domain) of the jn 625 620 !process 626 dxT = n imppt(jn) + nlcit(jn) - 1621 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 627 622 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 628 623 nsndto = nsndto + 1 629 isendto(nsndto) = jn630 ELSEIF ((sxM .le. sxT) .AND. (dxM .g t. dxT)) THEN624 isendto(nsndto) = jn 625 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 631 626 nsndto = nsndto + 1 632 isendto(nsndto) = jn627 isendto(nsndto) = jn 633 628 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 634 629 nsndto = nsndto + 1 635 isendto(nsndto) = jn630 isendto(nsndto) = jn 636 631 END IF 637 END IF638 632 END DO 633 nfsloop = 1 634 nfeloop = nlci 635 DO jn = 2,jpni-1 636 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 637 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 638 nfsloop = nldi 639 ENDIF 640 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 641 nfeloop = nlei 642 ENDIF 643 ENDIF 644 END DO 645 639 646 ENDIF 640 647 l_north_nogather = .TRUE. 641 642 648 END SUBROUTINE nemo_northcomms 643 649 #else … … 646 652 END SUBROUTINE nemo_northcomms 647 653 #endif 654 655 SUBROUTINE istate_init 656 !!---------------------------------------------------------------------- 657 !! *** ROUTINE istate_init *** 658 !! 659 !! ** Purpose : Initialization to zero of the dynamics and tracers. 660 !!---------------------------------------------------------------------- 661 ! 662 ! now fields ! after fields ! 663 un (:,:,:) = 0._wp ; ua(:,:,:) = 0._wp ! 664 vn (:,:,:) = 0._wp ; va(:,:,:) = 0._wp ! 665 wn (:,:,:) = 0._wp ! ! 666 hdivn(:,:,:) = 0._wp ! ! 667 tsn (:,:,:,:) = 0._wp ! ! 668 ! 669 rhd (:,:,:) = 0.e0 670 rhop (:,:,:) = 0.e0 671 rn2 (:,:,:) = 0.e0 672 ! 673 END SUBROUTINE istate_init 674 675 SUBROUTINE stp_ctl( kt, kindic ) 676 !!---------------------------------------------------------------------- 677 !! *** ROUTINE stp_ctl *** 678 !! 679 !! ** Purpose : Control the run 680 !! 681 !! ** Method : - Save the time step in numstp 682 !! 683 !! ** Actions : 'time.step' file containing the last ocean time-step 684 !!---------------------------------------------------------------------- 685 INTEGER, INTENT(in ) :: kt ! ocean time-step index 686 INTEGER, INTENT(inout) :: kindic ! indicator of solver convergence 687 !!---------------------------------------------------------------------- 688 ! 689 IF( kt == nit000 .AND. lwp ) THEN 690 WRITE(numout,*) 691 WRITE(numout,*) 'stp_ctl : time-stepping control' 692 WRITE(numout,*) '~~~~~~~' 693 ! open time.step file 694 CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 695 ENDIF 696 ! 697 IF(lwp) WRITE ( numstp, '(1x, i8)' ) kt !* save the current time step in numstp 698 IF(lwp) REWIND( numstp ) ! -------------------------- 699 ! 700 END SUBROUTINE stp_ctl 648 701 !!====================================================================== 649 702 END MODULE nemogcm
Note: See TracChangeset
for help on using the changeset viewer.
