- Timestamp:
- 2015-12-03T09:10:32+01:00 (9 years ago)
- Location:
- branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OFF_SRC
- Files:
-
- 4 deleted
- 3 edited
-
domain.F90 (deleted)
-
dommsk.F90 (deleted)
-
domrea.F90 (modified) (6 diffs)
-
dtadyn.F90 (modified) (16 diffs)
-
istate.F90 (deleted)
-
nemogcm.F90 (modified) (13 diffs)
-
stpctl.F90 (deleted)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r5260 r5989 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_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r5260 r5989 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 zdf_oce, ONLY: zwslpi => avmu , zwslpj => avmv 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 … … 264 261 fr_i(:,:) = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1) ! Sea-ice fraction 265 262 qsr (:,:) = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1) ! solar radiation 266 IF 263 IF( ln_dynrnf ) & 267 264 rnf (:,:) = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1) ! river runoffs 268 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 ) 269 268 ! ! bbl diffusive coef 270 269 #if defined key_trabbl && ! defined key_c1d … … 276 275 CALL bbl( kt, nit000, 'TRC') 277 276 END IF 278 #endif279 #if ( ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv ) && ! defined key_c1d280 aeiw(:,:) = sf_dyn(jf_eiw)%fnow(:,:,1) * tmask(:,:,1) ! w-eiv281 ! ! Computes the horizontal values from the vertical value282 DO jj = 2, jpjm1283 DO ji = fs_2, fs_jpim1 ! vector opt.284 aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj ) ) ! Average the diffusive coefficient at u- v- points285 aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji ,jj+1) ) ! at u- v- points286 END DO287 END DO288 CALL lbc_lnk( aeiu, 'U', 1. ) ; CALL lbc_lnk( aeiv, 'V', 1. ) ! lateral boundary condition289 #endif290 291 #if defined key_degrad && ! defined key_c1d292 ! ! degrad option : diffusive and eiv coef are 3D293 ahtu(:,:,:) = sf_dyn(jf_ahu)%fnow(:,:,:) * umask(:,:,:)294 ahtv(:,:,:) = sf_dyn(jf_ahv)%fnow(:,:,:) * vmask(:,:,:)295 ahtw(:,:,:) = sf_dyn(jf_ahw)%fnow(:,:,:) * tmask(:,:,:)296 # if defined key_traldf_eiv297 aeiu(:,:,:) = sf_dyn(jf_eiu)%fnow(:,:,:) * umask(:,:,:)298 aeiv(:,:,:) = sf_dyn(jf_eiv)%fnow(:,:,:) * vmask(:,:,:)299 aeiw(:,:,:) = sf_dyn(jf_eiw)%fnow(:,:,:) * tmask(:,:,:)300 # endif301 277 #endif 302 278 ! … … 339 315 TYPE(FLD_N), DIMENSION(jpfld) :: slf_d ! array of namelist informations on the fields to read 340 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 341 TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl ! " " 342 TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf ! " " 343 !!---------------------------------------------------------------------- 344 ! 345 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, & 346 319 & sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf, & 347 & sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, &348 & 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 !!---------------------------------------------------------------------- 349 322 ! 350 323 REWIND( numnam_ref ) ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data … … 365 338 WRITE(numout,*) ' vertical velocity read from file (T) or computed (F) ln_dynwzv = ', ln_dynwzv 366 339 WRITE(numout,*) ' bbl coef read from file (T) or computed (F) ln_dynbbl = ', ln_dynbbl 367 WRITE(numout,*) ' degradation option enabled (T) or not (F) ln_degrad = ', ln_degrad368 340 WRITE(numout,*) ' river runoff option enabled (T) or not (F) ln_dynrnf = ', ln_dynrnf 369 341 WRITE(numout,*) 370 342 ENDIF 371 343 ! 372 IF( ln_degrad .AND. .NOT.lk_degrad ) THEN373 CALL ctl_warn( 'dta_dyn_init: degradation option requires key_degrad activated ; force ln_degrad to false' )374 ln_degrad = .FALSE.375 ENDIF376 344 IF( ln_dynbbl .AND. ( .NOT.lk_trabbl .OR. lk_c1d ) ) THEN 377 345 CALL ctl_warn( 'dta_dyn_init: bbl option requires key_trabbl activated ; force ln_dynbbl to false' ) … … 388 356 389 357 ! 390 IF 358 IF( ln_dynrnf ) THEN 391 359 jf_rnf = jfld + 1 ; jfld = jf_rnf 392 360 slf_d(jf_rnf) = sn_rnf … … 395 363 ENDIF 396 364 397 ! 398 IF( .NOT.ln_degrad ) THEN ! no degrad option 399 IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN ! eiv & bbl 400 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; jf_eiw = jfld + 3 ; jfld = jf_eiw 401 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl ; slf_d(jf_eiw) = sn_eiw 402 ENDIF 403 IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN ! no eiv & bbl 365 IF( ln_dynbbl ) THEN ! eiv & bbl 404 366 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; jfld = jf_vbl 405 367 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 406 ENDIF 407 IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN ! eiv & no bbl 408 jf_eiw = jfld + 1 ; jfld = jf_eiw ; slf_d(jf_eiw) = sn_eiw 409 ENDIF 410 ELSE 411 jf_ahu = jfld + 1 ; jf_ahv = jfld + 2 ; jf_ahw = jfld + 3 ; jfld = jf_ahw 412 slf_d(jf_ahu) = sn_ahu ; slf_d(jf_ahv) = sn_ahv ; slf_d(jf_ahw) = sn_ahw 413 IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN ! eiv & bbl 414 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; 415 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 416 jf_eiu = jfld + 3 ; jf_eiv = jfld + 4 ; jf_eiw = jfld + 5 ; jfld = jf_eiw 417 slf_d(jf_eiu) = sn_eiu ; slf_d(jf_eiv) = sn_eiv ; slf_d(jf_eiw) = sn_eiw 418 ENDIF 419 IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN ! no eiv & bbl 420 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; jfld = jf_vbl 421 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 422 ENDIF 423 IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN ! eiv & no bbl 424 jf_eiu = jfld + 1 ; jf_eiv = jfld + 2 ; jf_eiw = jfld + 3 ; jfld = jf_eiw 425 slf_d(jf_eiu) = sn_eiu ; slf_d(jf_eiv) = sn_eiv ; slf_d(jf_eiw) = sn_eiw 426 ENDIF 427 ENDIF 428 368 ENDIF 369 370 429 371 ALLOCATE( sf_dyn(jfld), STAT=ierr ) ! set sf structure 430 372 IF( ierr > 0 ) THEN 431 373 CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' ) ; RETURN 432 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' ) 433 377 ! Open file for each variable to get his number of dimension 434 378 DO ifpr = 1, jfld 435 CALL iom_open( TRIM( cn_dir )//TRIM( slf_d(ifpr)%clname ), inum ) 436 idv = iom_varid( inum , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar 437 idimv = iom_file ( inum )%ndims(idv) ! number of dimension for variable sdjf%clvar 438 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 439 384 IF( idimv == 3 ) THEN ! 2D variable 440 385 ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 ) … … 448 393 ENDIF 449 394 END DO 450 ! ! fill sf with slf_i and control print 451 CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 452 ! 453 IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN ! slopes 395 ! 396 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! slopes 454 397 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! time interpolation 455 398 ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2), & … … 510 453 zv = pv(ji ,jj ,jk) * vmask(ji ,jj ,jk) * e1v(ji ,jj ) * fse3v(ji ,jj ,jk) 511 454 zv1 = pv(ji ,jj-1,jk) * vmask(ji ,jj-1,jk) * e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk) 512 zet = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )455 zet = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 513 456 zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet 514 457 END DO 515 458 END DO 516 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 ! 517 463 CALL lbc_lnk( zhdiv, 'T', 1. ) ! Lateral boundary conditions on zhdiv 518 !519 464 ! computation of vertical velocity from the bottom 520 465 pw(:,:,jpk) = 0._wp … … 539 484 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pwslpj ! meridional diapycnal slopes 540 485 !!--------------------------------------------------------------------- 541 #if defined key_ldfslp && ! defined key_c1d 542 CALL eos ( pts, rhd, rhop, gdept_0(:,:,:) )543 CALL eos_rab( pts, rab_n ) ! now local thermal/haline expension ratio at T-points544 CALL bn2 ( pts, rab_n, rn2 ) ! now Brunt-Vaisala545 546 ! Partial steps: before Horizontal DErivative547 IF( ln_zps .AND. .NOT. ln_isfcav) &548 & CALL zps_hde ( kt, jpts, pts, gtsu, gtsv, & ! Partial steps: before horizontal gradient549 & rhd, gru , grv ) ! of t, s, rd at the last ocean level550 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 level554 555 rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl556 CALL zdf_mxl( kt ) ! mixed layer depth557 CALL ldf_slp( kt, rhd, rn2 ) ! slopes558 puslp (:,:,:) = uslp (:,:,:)559 pvslp (:,:,:) = vslp (:,:,:)560 pwslpi(:,:,:) = wslpi(:,:,:)561 pwslpj(:,:,:) = wslpj(:,:,:)562 #else 563 puslp (:,:,:) = 0. ! to avoid warning when compiling564 pvslp (:,:,:) = 0.565 pwslpi(:,:,:) = 0.566 pwslpj(:,:,:) = 0.567 #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 568 513 ! 569 514 END SUBROUTINE dta_dyn_slp -
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
r5260 r5989 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 … … 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 !! … … 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 … … 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') … … 450 445 USE dom_oce, ONLY: dom_oce_alloc 451 446 USE zdf_oce, ONLY: zdf_oce_alloc 452 USE ldftra_oce, ONLY: ldftra_oce_alloc453 447 USE trc_oce, ONLY: trc_oce_alloc 454 448 ! … … 459 453 ierr = ierr + dia_wri_alloc () 460 454 ierr = ierr + dom_oce_alloc () ! ocean domain 461 ierr = ierr + ldftra_oce_alloc() ! ocean lateral physics : tracers462 455 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 463 456 ! … … 659 652 END SUBROUTINE nemo_northcomms 660 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 661 701 !!====================================================================== 662 702 END MODULE nemogcm
Note: See TracChangeset
for help on using the changeset viewer.
