Changeset 5989 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
- Timestamp:
- 2015-12-03T09:10:32+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r5260 r5989 28 28 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 29 29 !! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 30 !! 3.4 ! 2011-11 (C. Harris) decomposition changes for running with CICE 31 !! ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 30 !! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms 31 !! - ! 2011-11 (C. Harris) decomposition changes for running with CICE 32 !! 3.6 ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 33 !! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 34 !! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla) 32 35 !!---------------------------------------------------------------------- 33 36 … … 41 44 !! factorise : calculate the factors of the no. of MPI processes 42 45 !!---------------------------------------------------------------------- 43 USE step_oce ! module used in the ocean time stepping module 44 USE cla ! cross land advection (tra_cla routine) 46 USE step_oce ! module used in the ocean time stepping module (step.F90) 45 47 USE domcfg ! domain configuration (dom_cfg routine) 46 48 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 77 79 USE lib_mpp ! distributed memory computing 78 80 #if defined key_iomput 79 USE xios 80 #endif 81 USE sbctide, ONLY : lk_tide81 USE xios ! xIOserver 82 #endif 83 USE sbctide, ONLY : lk_tide 82 84 USE crsini ! initialise grid coarsening utility 83 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 85 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 86 USE sbc_oce, ONLY : lk_oasis 87 USE stopar 88 USE stopts 84 89 USE diatmb ! Top,middle,bottom output 85 90 USE dia25h ! 25h mean output … … 95 100 96 101 !!---------------------------------------------------------------------- 97 !! NEMO/OPA 4.0 , NEMO Consortium (2011)102 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 98 103 !! $Id$ 99 104 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 160 165 ENDIF 161 166 167 #if defined key_agrif 168 CALL Agrif_Regrid() 169 #endif 170 162 171 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 163 172 #if defined key_agrif 164 CALL Agrif_Step( stp )! AGRIF: time stepping173 CALL stp ! AGRIF: time stepping 165 174 #else 166 175 CALL stp( istp ) ! standard time stepping … … 186 195 ! 187 196 #if defined key_agrif 188 CALL Agrif_ParentGrid_To_ChildGrid() 189 IF( lk_diaobs ) CALL dia_obs_wri 197 IF(.NOT.Agrif_Root() ) THEN 198 CALL Agrif_ParentGrid_To_ChildGrid() 199 IF( lk_diaobs ) CALL dia_obs_wri 200 IF( nn_timing == 1 ) CALL timing_finalize 201 CALL Agrif_ChildGrid_To_ParentGrid() 202 ENDIF 203 #endif 190 204 IF( nn_timing == 1 ) CALL timing_finalize 191 CALL Agrif_ChildGrid_To_ParentGrid()192 #endif193 IF( nn_timing == 1 ) CALL timing_finalize194 205 ! 195 206 CALL nemo_closefile 196 207 ! 197 208 #if defined key_iomput 198 CALL xios_finalize ! end mpp communications with xios199 IF( lk_ cpl ) CALL cpl_finalize! end coupling and mpp communications with OASIS209 CALL xios_finalize ! end mpp communications with xios 210 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 200 211 #else 201 IF( lk_ cpl) THEN212 IF( lk_oasis ) THEN 202 213 CALL cpl_finalize ! end coupling and mpp communications with OASIS 203 214 ELSE … … 228 239 ! 229 240 cltxt = '' 241 cxios_context = 'nemo' 230 242 ! 231 243 ! ! Open reference namelist and configuration namelist files … … 274 286 #if defined key_iomput 275 287 IF( Agrif_Root() ) THEN 276 IF( lk_ cpl) THEN277 CALL cpl_init( ilocal_comm )! nemo local communicator given by oasis278 CALL xios_initialize( " oceanx",local_comm=ilocal_comm ) ! send nemo communicator to xios288 IF( lk_oasis ) THEN 289 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 290 CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios 279 291 ELSE 280 CALL xios_initialize( " nemo",return_comm=ilocal_comm ) ! nemo local communicator given by xios292 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios 281 293 ENDIF 282 294 ENDIF 283 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 295 ! Nodes selection (control print return in cltxt) 296 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 284 297 #else 285 IF( lk_ cpl) THEN298 IF( lk_oasis ) THEN 286 299 IF( Agrif_Root() ) THEN 287 CALL cpl_init( ilocal_comm )! nemo local communicator given by oasis300 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 288 301 ENDIF 289 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 302 ! Nodes selection (control print return in cltxt) 303 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 290 304 ELSE 291 305 ilocal_comm = 0 292 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 306 ! Nodes selection (control print return in cltxt) 307 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 293 308 ENDIF 294 309 #endif … … 308 323 ! If dimensions of processor grid weren't specified in the namelist file 309 324 ! then we calculate them here now that we have our communicator size 310 IF( (jpni < 1) .OR. (jpnj < 1) )THEN325 IF( jpni < 1 .OR. jpnj < 1 ) THEN 311 326 #if defined key_mpp_mpi 312 IF( Agrif_Root() ) CALL nemo_partition(mppsize)327 IF( Agrif_Root() ) CALL nemo_partition( mppsize ) 313 328 #else 314 329 jpni = 1 … … 316 331 jpnij = jpni*jpnj 317 332 #endif 318 END 333 ENDIF 319 334 320 335 ! Calculate domain dimensions given calculated jpni and jpnj 321 ! This used to be done in par_oce.F90 when they were parameters rather 322 ! than variables 336 ! This used to be done in par_oce.F90 when they were parameters rather than variables 323 337 IF( Agrif_Root() ) THEN 324 338 #if defined key_nemocice_decomp 325 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim.326 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.339 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 340 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 327 341 #else 328 jpi = ( jpiglo -2*jpreci + (jpni-1) ) / jpni + 2*jpreci! first dim.329 jpj = ( jpjglo -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj! second dim.330 #endif 331 ENDIF 342 jpi = ( jpiglo -2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 343 jpj = ( jpjglo -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 344 #endif 345 ENDIF 332 346 jpk = jpkdta ! third dim 347 #if defined key_agrif 348 ! simple trick to use same vertical grid as parent but different number of levels: 349 ! Save maximum number of levels in jpkdta, then define all vertical grids with this number. 350 ! Suppress once vertical online interpolation is ok 351 IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent( jpkdta ) 352 #endif 333 353 jpim1 = jpi-1 ! inner domain indices 334 354 jpjm1 = jpj-1 ! " " … … 344 364 WRITE(numout,*) ' NEMO team' 345 365 WRITE(numout,*) ' Ocean General Circulation Model' 346 WRITE(numout,*) ' version 3. 6(2015) '366 WRITE(numout,*) ' version 3.7 (2015) ' 347 367 WRITE(numout,*) 348 368 WRITE(numout,*) … … 377 397 CALL dom_cfg ! Domain configuration 378 398 CALL dom_init ! Domain 379 380 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 381 399 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization 400 IF( ln_nnogather ) CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined) 382 401 IF( ln_ctl ) CALL prt_ctl_init ! Print control 383 384 402 CALL istate_init ! ocean initial state (Dynamics and tracers) 385 403 386 IF( lk_tide ) CALL tide_init( nit000 ) ! Initialisation of the tidal harmonics 387 388 CALL sbc_init ! Forcings : surface module (clem: moved here for bdy purpose) 389 404 ! ! external forcing 405 !!gm to be added : creation and call of sbc_apr_init 406 IF( lk_tide ) CALL tide_init( nit000 ) ! tidal harmonics 407 CALL sbc_init ! surface boundary conditions (including sea-ice) 408 !!gm ==>> bdy_init should call bdy_dta_init and bdytide_init NOT in nemogcm !!! 390 409 IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation 391 410 IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays 392 411 IF( lk_bdy .AND. lk_tide ) & 393 412 & CALL bdytide_init ! Open boundaries initialisation of tidal harmonic forcing 394 395 CALL dyn_nept_init ! simplified form of Neptune effect 396 ! 397 IF( ln_crs ) CALL crs_init ! Domain initialization of coarsened grid 398 ! 399 ! Ocean physics 413 414 ! ! Ocean physics 400 415 ! ! Vertical physics 401 416 CALL zdf_init ! namelist read … … 404 419 IF( lk_zdftke ) CALL zdf_tke_init ! TKE closure scheme 405 420 IF( lk_zdfgls ) CALL zdf_gls_init ! GLS closure scheme 406 IF( lk_zdfkpp ) CALL zdf_kpp_init ! KPP closure scheme407 421 IF( lk_zdftmx ) CALL zdf_tmx_init ! tidal vertical mixing 408 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) &409 & CALL zdf_ddm_init ! double diffusive mixing422 IF( lk_zdfddm ) CALL zdf_ddm_init ! double diffusive mixing 423 410 424 ! ! Lateral physics 411 425 CALL ldf_tra_init ! Lateral ocean tracer physics 426 CALL ldf_eiv_init ! eddy induced velocity param. 412 427 CALL ldf_dyn_init ! Lateral ocean momentum physics 413 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 414 415 ! ! Active tracers 416 CALL tra_qsr_init ! penetrative solar radiation qsr 417 CALL tra_bbc_init ! bottom heat flux 418 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 419 CALL tra_dmp_init ! internal damping trends- tracers 420 CALL tra_adv_init ! horizontal & vertical advection 421 CALL tra_ldf_init ! lateral mixing 422 CALL tra_zdf_init ! vertical mixing and after tracer fields 423 424 ! ! Dynamics 425 IF( lk_c1d ) CALL dyn_dmp_init ! internal damping trends- momentum 426 CALL dyn_adv_init ! advection (vector or flux form) 427 CALL dyn_vor_init ! vorticity term including Coriolis 428 CALL dyn_ldf_init ! lateral mixing 429 CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure 430 CALL dyn_zdf_init ! vertical diffusion 431 CALL dyn_spg_init ! surface pressure gradient 432 433 ! ! Misc. options 434 IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 ) CALL cla_init ! Cross Land Advection 428 429 ! ! Active tracers 430 CALL tra_qsr_init ! penetrative solar radiation qsr 431 CALL tra_bbc_init ! bottom heat flux 432 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 433 CALL tra_dmp_init ! internal tracer damping 434 CALL tra_adv_init ! horizontal & vertical advection 435 CALL tra_ldf_init ! lateral mixing 436 CALL tra_zdf_init ! vertical mixing and after tracer fields 437 438 ! ! Dynamics 439 IF( lk_c1d ) CALL dyn_dmp_init ! internal momentum damping 440 CALL dyn_adv_init ! advection (vector or flux form) 441 CALL dyn_vor_init ! vorticity term including Coriolis 442 CALL dyn_ldf_init ! lateral mixing 443 CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure 444 CALL dyn_zdf_init ! vertical diffusion 445 CALL dyn_spg_init ! surface pressure gradient 446 447 #if defined key_top 448 ! ! Passive tracers 449 CALL trc_init 450 #endif 451 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 452 453 ! ! Icebergs 435 454 CALL icb_init( rdt, nit000) ! initialise icebergs instance 455 456 ! ! Misc. options 457 CALL sto_par_init ! Stochastic parametrization 458 IF( ln_sto_eos ) CALL sto_pts_init ! RRandom T/S fluctuations 436 459 437 #if defined key_top 438 ! ! Passive tracers 439 CALL trc_init 440 #endif 441 ! ! Diagnostics 460 ! ! Diagnostics 442 461 IF( lk_floats ) CALL flo_init ! drifting Floats 443 462 IF( lk_diaar5 ) CALL dia_ar5_init ! ar5 diag … … 450 469 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 451 470 ENDIF 452 453 ! ! Assimilation increments 471 ! ! Assimilation increments 454 472 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 455 473 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler … … 501 519 WRITE(numout,*) '~~~~~~~ ' 502 520 WRITE(numout,*) ' Namelist namcfg' 503 WRITE(numout,*) ' configuration name cp_cfg= ', TRIM(cp_cfg)504 WRITE(numout,*) ' configuration zoom name cp_cfz= ', TRIM(cp_cfz)505 WRITE(numout,*) ' configuration resolution jp_cfg= ', jp_cfg506 WRITE(numout,*) ' 1st lateral dimension ( >= jpi ) jpidta= ', jpidta507 WRITE(numout,*) ' 2nd " " ( >= jpj ) jpjdta= ', jpjdta508 WRITE(numout,*) ' 3nd " " jpkdta= ', jpkdta509 WRITE(numout,*) ' 1st dimension of global domain in i jpiglo = ', jpiglo510 WRITE(numout,*) ' 2nd - - in j jpjglo = ', jpjglo521 WRITE(numout,*) ' configuration name cp_cfg = ', TRIM(cp_cfg) 522 WRITE(numout,*) ' configuration zoom name cp_cfz = ', TRIM(cp_cfz) 523 WRITE(numout,*) ' configuration resolution jp_cfg = ', jp_cfg 524 WRITE(numout,*) ' 1st lateral dimension ( >= jpiglo ) jpidta = ', jpidta 525 WRITE(numout,*) ' 2nd " " ( >= jpjglo ) jpjdta = ', jpjdta 526 WRITE(numout,*) ' 3nd " " jpkdta = ', jpkdta 527 WRITE(numout,*) ' 1st dimension of global domain in i jpiglo = ', jpiglo 528 WRITE(numout,*) ' 2nd - - in j jpjglo = ', jpjglo 511 529 WRITE(numout,*) ' left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 512 530 WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 513 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio= ', jperio531 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio 514 532 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 515 533 ENDIF … … 592 610 IF( numdct_heat /= -1 ) CLOSE( numdct_heat ) ! heat transports 593 611 IF( numdct_salt /= -1 ) CLOSE( numdct_salt ) ! salt transports 594 595 612 ! 596 613 numout = 6 ! redefine numout in case it is used after this point... … … 609 626 USE diawri , ONLY: dia_wri_alloc 610 627 USE dom_oce , ONLY: dom_oce_alloc 611 USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc612 USE ldftra_oce, ONLY: ldftra_oce_alloc613 628 USE trc_oce , ONLY: trc_oce_alloc 614 629 USE diainsitutem, ONLY: insitu_tem_alloc … … 626 641 ierr = ierr + dia_wri_alloc () 627 642 ierr = ierr + dom_oce_alloc () ! ocean domain 628 ierr = ierr + ldfdyn_oce_alloc() ! ocean lateral physics : dynamics629 ierr = ierr + ldftra_oce_alloc() ! ocean lateral physics : tracers630 643 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 631 644 ierr = ierr + insitu_tem_alloc() … … 708 721 INTEGER :: ifac, jl, inu 709 722 INTEGER, PARAMETER :: ntest = 14 710 INTEGER :: ilfax(ntest) 723 INTEGER, DIMENSION(ntest) :: ilfax 724 !!---------------------------------------------------------------------- 711 725 ! 712 726 ! lfax contains the set of allowed factors. 713 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & 714 & 128, 64, 32, 16, 8, 4, 2 / 715 !!---------------------------------------------------------------------- 716 727 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 728 ! 717 729 ! Clear the error flag and initialise output vars 718 kerr = 0719 kfax = 1730 kerr = 0 731 kfax = 1 720 732 knfax = 0 721 733 ! 722 734 ! Find the factors of n. 723 735 IF( kn == 1 ) GOTO 20 … … 727 739 ! l points to the allowed factor list. 728 740 ! ifac holds the current factor. 729 741 ! 730 742 inu = kn 731 743 knfax = 0 732 744 ! 733 745 DO jl = ntest, 1, -1 734 746 ! … … 754 766 ! 755 767 END DO 756 768 ! 757 769 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 758 770 ! … … 762 774 763 775 SUBROUTINE nemo_northcomms 764 !! ======================================================================776 !!---------------------------------------------------------------------- 765 777 !! *** ROUTINE nemo_northcomms *** 766 !! nemo_northcomms : Setup for north fold exchanges with explicit 767 !! point-to-point messaging 768 !!===================================================================== 769 !!---------------------------------------------------------------------- 770 !! 771 !! ** Purpose : Initialization of the northern neighbours lists. 778 !! ** Purpose : Setup for north fold exchanges with explicit 779 !! point-to-point messaging 780 !! 781 !! ** Method : Initialization of the northern neighbours lists. 772 782 !!---------------------------------------------------------------------- 773 783 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 774 784 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 775 785 !!---------------------------------------------------------------------- 776 777 786 INTEGER :: sxM, dxM, sxT, dxT, jn 778 787 INTEGER :: njmppmax 779 788 !!---------------------------------------------------------------------- 789 ! 780 790 njmppmax = MAXVAL( njmppt ) 781 791 ! 782 792 !initializes the north-fold communication variables 783 793 isendto(:) = 0 784 nsndto = 0785 794 nsndto = 0 795 ! 786 796 !if I am a process in the north 787 797 IF ( njmpp == njmppmax ) THEN … … 830 840 l_north_nogather = .TRUE. 831 841 END SUBROUTINE nemo_northcomms 842 832 843 #else 833 844 SUBROUTINE nemo_northcomms ! Dummy routine … … 839 850 END MODULE nemogcm 840 851 841
Note: See TracChangeset
for help on using the changeset viewer.
