- Timestamp:
- 2016-11-21T09:55:07+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r6152 r7277 33 33 !! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 34 34 !! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla) 35 !! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface 35 36 !!---------------------------------------------------------------------- 36 37 … … 45 46 !!---------------------------------------------------------------------- 46 47 USE step_oce ! module used in the ocean time stepping module (step.F90) 47 USE domcfg ! domain configuration (dom_cfg routine) 48 USE mppini ! shared/distributed memory setting (mpp_init routine) 49 USE domain ! domain initialization (dom_init routine) 50 #if defined key_nemocice_decomp 51 USE ice_domain_size, only: nx_global, ny_global 52 #endif 48 USE phycst ! physical constant (par_cst routine) 49 USE domain ! domain initialization (dom_init & dom_cfg routines) 50 USE usrdef_nam ! user defined configuration 53 51 USE tideini ! tidal components initialization (tide_ini routine) 54 52 USE bdyini ! open boundary cond. setting (bdy_init routine) … … 60 58 USE ldftra ! lateral diffusivity setting (ldftra_init routine) 61 59 USE zdfini ! vertical physics setting (zdf_init routine) 62 USE phycst ! physical constant (par_cst routine)63 60 USE trdini ! dyn/tra trends initialization (trd_init routine) 64 61 USE asminc ! assimilation increments … … 68 65 USE diaobs ! Observation diagnostics (dia_obs_init routine) 69 66 USE diacfl ! CFL diagnostics (dia_cfl_init routine) 70 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)71 67 USE step ! NEMO time-stepping (stp routine) 72 68 USE icbini ! handle bergs, initialisation … … 78 74 USE stopar ! Stochastic param.: ??? 79 75 USE stopts ! Stochastic param.: ??? 76 USE diurnal_bulk ! diurnal bulk SST 77 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline) 78 USE crsini ! initialise grid coarsening utility 79 USE diatmb ! Top,middle,bottom output 80 USE dia25h ! 25h mean output 81 USE sbc_oce , ONLY : lk_oasis 82 USE wet_dry ! Wetting and drying setting (wad_init routine) 80 83 #if defined key_top 81 84 USE trcini ! passive tracer initialisation 82 85 #endif 86 #if defined key_nemocice_decomp 87 USE ice_domain_size, only: nx_global, ny_global 88 #endif 89 ! 83 90 USE lib_mpp ! distributed memory computing 84 USE diurnal_bulk ! diurnal bulk SST 85 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline) 91 USE mppini ! shared/distributed memory setting (mpp_init routine) 92 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 93 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 86 94 #if defined key_iomput 87 95 USE xios ! xIOserver 88 96 #endif 89 USE crsini ! initialise grid coarsening utility90 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges91 USE sbc_oce, ONLY : lk_oasis92 USE diatmb ! Top,middle,bottom output93 USE dia25h ! 25h mean output94 USE wet_dry ! Wetting and drying setting (wad_init routine)95 97 96 98 IMPLICIT NONE … … 104 106 105 107 !!---------------------------------------------------------------------- 106 !! NEMO/OPA 3.7 , NEMO Consortium (2015)108 !! NEMO/OPA 4.0 , NEMO Consortium (2016) 107 109 !! $Id$ 108 110 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 124 126 !! Madec, 2008, internal report, IPSL. 125 127 !!---------------------------------------------------------------------- 126 INTEGER :: istp 128 INTEGER :: istp ! time step index 127 129 !!---------------------------------------------------------------------- 128 130 ! … … 130 132 CALL Agrif_Init_Grids() ! AGRIF: set the meshes 131 133 #endif 132 134 ! 133 135 ! !-----------------------! 134 136 CALL nemo_init !== Initialisations ==! … … 195 197 ! !== finalize the run ==! 196 198 ! !------------------------! 197 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA198 ! 199 IF( nstop /= 0 .AND. lwp ) THEN ! error print199 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 200 ! 201 IF( nstop /= 0 .AND. lwp ) THEN ! error print 200 202 WRITE(numout,cform_err) 201 203 WRITE(numout,*) nstop, ' error have been found' … … 215 217 ! 216 218 #if defined key_iomput 217 CALL xios_finalize ! end mpp communications with xios218 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS219 CALL xios_finalize ! end mpp communications with xios 220 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 219 221 #else 220 222 IF( lk_oasis ) THEN 221 CALL cpl_finalize ! end coupling and mpp communications with OASIS223 CALL cpl_finalize ! end coupling and mpp communications with OASIS 222 224 ELSE 223 IF( lk_mpp ) CALL mppstop ! end mpp communications225 IF( lk_mpp ) CALL mppstop ! end mpp communications 224 226 ENDIF 225 227 #endif … … 234 236 !! ** Purpose : initialization of the NEMO GCM 235 237 !!---------------------------------------------------------------------- 236 INTEGER :: ji! dummy loop indices237 INTEGER ::ilocal_comm ! local integer238 INTEGER :: ios239 CHARACTER(len=80), DIMENSION(16) :: cltxt240 !241 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, &242 & nn_ isplt, nn_jsplt, nn_jctls, nn_jctle, &243 & nn_bench, nn_timing, nn_diacfl244 NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &245 & jpizoom, jpjzoom, jperio, ln_use_jattr246 !!----------------------------------------------------------------------247 !248 cl txt = ''238 INTEGER :: ji ! dummy loop indices 239 INTEGER :: ios, ilocal_comm ! local integer 240 CHARACTER(len=120), DIMENSION(30) :: cltxt, cltxt2, clnam 241 ! 242 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 243 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 244 & nn_timing, nn_diacfl 245 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr 246 !!---------------------------------------------------------------------- 247 ! 248 cltxt = '' 249 cltxt2 = '' 250 clnam = '' 249 251 cxios_context = 'nemo' 250 252 ! … … 253 255 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 254 256 ! 255 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints & Benchmark257 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints 256 258 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 257 259 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 258 259 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist : Control prints & Benchmark260 ! 261 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist 260 262 READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 261 263 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 262 263 ! 264 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist : Control prints & Benchmark 264 ! 265 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist : Control prints 265 266 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 266 267 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) … … 270 271 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 271 272 272 ! Force values for AGRIF zoom (cf. agrif_user.F90) 273 ! !--------------------------! 274 ! ! Set global domain size ! (control print return in cltxt2) 275 ! !--------------------------! 276 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 277 CALL domain_cfg ( cltxt2, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 278 ! 279 ELSE ! user-defined namelist 280 CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 281 ENDIF 282 ! 283 jpk = jpkglo 284 ! 273 285 #if defined key_agrif 274 IF( .NOT. Agrif_Root() ) THEN 275 jpiglo = nbcellsx + 2 + 2*nbghostcells 276 jpjglo = nbcellsy + 2 + 2*nbghostcells 277 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 278 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 279 jpidta = jpiglo 280 jpjdta = jpjglo 281 jpizoom = 1 282 jpjzoom = 1 283 nperio = 0 284 jperio = 0 285 ln_use_jattr = .false. 286 ENDIF 286 IF( .NOT. Agrif_Root() ) THEN ! AGRIF children: specific setting (cf. agrif_user.F90) 287 jpiglo = nbcellsx + 2 + 2*nbghostcells 288 jpjglo = nbcellsy + 2 + 2*nbghostcells 289 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 290 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 291 nperio = 0 292 jperio = 0 293 ln_use_jattr = .false. 294 ENDIF 287 295 #endif 288 296 ! … … 295 303 IF( Agrif_Root() ) THEN 296 304 IF( lk_oasis ) THEN 297 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis298 CALL xios_initialize( "not used" ,local_comm=ilocal_comm ) ! send nemo communicator to xios305 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 306 CALL xios_initialize( "not used" ,local_comm= ilocal_comm ) ! send nemo communicator to xios 299 307 ELSE 300 CALL 308 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios 301 309 ENDIF 302 310 ENDIF … … 306 314 IF( lk_oasis ) THEN 307 315 IF( Agrif_Root() ) THEN 308 CALL cpl_init( "oceanx", ilocal_comm ) 316 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 309 317 ENDIF 310 318 ! Nodes selection (control print return in cltxt) 311 319 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 312 320 ELSE 313 ilocal_comm = 0 314 ! Nodes selection (control print return in cltxt) 321 ilocal_comm = 0 ! Nodes selection (control print return in cltxt) 315 322 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 316 323 ENDIF 317 324 #endif 325 318 326 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 319 327 … … 321 329 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 322 330 323 IF(lwm) THEN 324 ! write merged namelists from earlier to output namelist now that the 325 ! file has been opened in call to mynode. nammpp has already been 326 ! written in mynode (if lk_mpp_mpi) 331 IF(lwm) THEN ! write merged namelists from earlier to output namelist 332 ! ! now that the file has been opened in call to mynode. 333 ! ! NB: nammpp has already been written in mynode (if lk_mpp_mpi) 327 334 WRITE( numond, namctl ) 328 335 WRITE( numond, namcfg ) 336 IF( .NOT.ln_read_cfg ) THEN 337 DO ji = 1, SIZE(clnam) 338 IF( TRIM(clnam(ji)) /= '' ) WRITE(numond, * ) clnam(ji) ! namusr_def print 339 END DO 340 ENDIF 329 341 ENDIF 330 342 … … 341 353 ENDIF 342 354 343 ! Calculate domain dimensions given calculated jpni and jpnj 344 ! This used to be done in par_oce.F90 when they were parameters rather than variables 345 IF( Agrif_Root() ) THEN 355 IF( Agrif_Root() ) THEN ! AGRIF mother: specific setting from jpni and jpnj 346 356 #if defined key_nemocice_decomp 347 357 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. … … 351 361 jpj = ( jpjglo -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 352 362 #endif 353 ENDIF 354 jpk = jpkdta ! third dim 363 ENDIF 364 365 !!gm ??? why here it has already been done in line 301 ! 366 jpk = jpkglo ! third dim 367 !!gm end 368 355 369 #if defined key_agrif 356 357 ! Save maximum number of levels in jpkdta, then define all vertical grids with this number.358 359 IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent( jpkdta)360 #endif 361 362 363 364 370 ! simple trick to use same vertical grid as parent but different number of levels: 371 ! Save maximum number of levels in jpkglo, then define all vertical grids with this number. 372 ! Suppress once vertical online interpolation is ok 373 IF(.NOT.Agrif_Root()) jpkglo = Agrif_Parent( jpkglo ) 374 #endif 375 jpim1 = jpi-1 ! inner domain indices 376 jpjm1 = jpj-1 ! " " 377 jpkm1 = jpk-1 ! " " 378 jpij = jpi*jpj ! jpi x j 365 379 366 380 IF(lwp) THEN ! open listing units … … 372 386 WRITE(numout,*) ' NEMO team' 373 387 WRITE(numout,*) ' Ocean General Circulation Model' 374 WRITE(numout,*) ' version 3.7 (2015) '388 WRITE(numout,*) ' NEMO version 3.7 (2016) ' 375 389 WRITE(numout,*) 376 390 WRITE(numout,*) 377 391 DO ji = 1, SIZE(cltxt) 378 IF( TRIM(cltxt (ji)) /= '' ) WRITE(numout,*) cltxt(ji)! control print of mynode392 IF( TRIM(cltxt (ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode 379 393 END DO 380 WRITE(numout,cform_aaa) ! Flag AAAAAAA 394 WRITE(numout,*) 395 WRITE(numout,*) 396 DO ji = 1, SIZE(cltxt2) 397 IF( TRIM(cltxt2(ji)) /= '' ) WRITE(numout,*) cltxt2(ji) ! control print of domain size 398 END DO 381 399 ! 382 ENDIF 383 384 ! Now we know the dimensions of the grid and numout has been set we can 385 ! allocate arrays 400 WRITE(numout,cform_aaa) ! Flag AAAAAAA 401 ! 402 ENDIF 403 404 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 386 405 CALL nemo_alloc() 387 406 … … 390 409 ! !-------------------------------! 391 410 392 CALL nemo_ctl ! Control prints & Benchmark411 CALL nemo_ctl ! Control prints 393 412 394 413 ! ! Domain decomposition … … 404 423 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 405 424 CALL wad_init ! Wetting and drying options 406 CALL dom_cfg ! Domain configuration407 425 CALL dom_init ! Domain 408 426 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization … … 503 521 CALL dia_tmb_init ! TMB outputs 504 522 CALL dia_25h_init ! 25h mean outputs 505 506 523 ! 507 524 END SUBROUTINE nemo_init … … 519 536 IF(lwp) THEN ! control print 520 537 WRITE(numout,*) 521 WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark'538 WRITE(numout,*) 'nemo_ctl: Control prints' 522 539 WRITE(numout,*) '~~~~~~~ ' 523 540 WRITE(numout,*) ' Namelist namctl' … … 530 547 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt 531 548 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt 532 WRITE(numout,*) ' benchmark parameter (0/1) nn_bench = ', nn_bench533 549 WRITE(numout,*) ' timing activated (0/1) nn_timing = ', nn_timing 534 550 ENDIF … … 541 557 isplt = nn_isplt 542 558 jsplt = nn_jsplt 543 nbench = nn_bench544 559 545 560 IF(lwp) THEN ! control print … … 548 563 WRITE(numout,*) '~~~~~~~ ' 549 564 WRITE(numout,*) ' Namelist namcfg' 550 WRITE(numout,*) ' configuration name cp_cfg = ', TRIM(cp_cfg) 551 WRITE(numout,*) ' configuration zoom name cp_cfz = ', TRIM(cp_cfz) 552 WRITE(numout,*) ' configuration resolution jp_cfg = ', jp_cfg 553 WRITE(numout,*) ' 1st lateral dimension ( >= jpiglo ) jpidta = ', jpidta 554 WRITE(numout,*) ' 2nd " " ( >= jpjglo ) jpjdta = ', jpjdta 555 WRITE(numout,*) ' 3nd " " jpkdta = ', jpkdta 556 WRITE(numout,*) ' 1st dimension of global domain in i jpiglo = ', jpiglo 557 WRITE(numout,*) ' 2nd - - in j jpjglo = ', jpjglo 558 WRITE(numout,*) ' left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 559 WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 560 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio 561 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 565 WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg 566 WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg) 567 WRITE(numout,*) ' write configuration definition file ln_write_cfg = ', ln_write_cfg 568 WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out) 569 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 562 570 ENDIF 563 571 ! ! Parameter control … … 600 608 ENDIF 601 609 ! 602 IF( nbench == 1 ) THEN ! Benchmark603 SELECT CASE ( cp_cfg )604 CASE ( 'gyre' ) ; CALL ctl_warn( ' The Benchmark is activated ' )605 CASE DEFAULT ; CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:', &606 & ' cp_cfg = "gyre" in namelist &namcfg or set nbench = 0' )607 END SELECT608 ENDIF609 !610 610 IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', & 611 611 & 'f2003 standard. ' , & … … 666 666 !!---------------------------------------------------------------------- 667 667 ! 668 ierr = oce_alloc () ! ocean 668 ierr = oce_alloc () ! ocean 669 669 ierr = ierr + dia_wri_alloc () 670 670 ierr = ierr + dom_oce_alloc () ! ocean domain … … 842 842 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 843 843 nsndto = nsndto + 1 844 844 isendto(nsndto) = jn 845 845 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 846 846 nsndto = nsndto + 1 847 847 isendto(nsndto) = jn 848 848 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 849 849 nsndto = nsndto + 1 850 851 END 850 isendto(nsndto) = jn 851 ENDIF 852 852 END DO 853 853 nfsloop = 1
Note: See TracChangeset
for help on using the changeset viewer.
