Changeset 6041 for branches/2015/dev_r5776_UKMO2_OBS_efficiency_improvs/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
- Timestamp:
- 2015-12-14T10:06:06+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5776_UKMO2_OBS_efficiency_improvs/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r5656 r6041 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 exchanges84 USE sbc_oce, ONLY : lk_oasis85 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 86 USE sbc_oce, ONLY : lk_oasis 85 87 USE stopar 86 88 USE stopts … … 96 98 97 99 !!---------------------------------------------------------------------- 98 !! NEMO/OPA 4.0 , NEMO Consortium (2011)100 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 99 101 !! $Id$ 100 102 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 191 193 ! 192 194 #if defined key_agrif 193 IF( .NOT.Agrif_Root() ) THEN194 CALL Agrif_ParentGrid_To_ChildGrid()195 IF( lk_diaobs ) CALL dia_obs_wri195 IF(.NOT.Agrif_Root() ) THEN 196 CALL Agrif_ParentGrid_To_ChildGrid() 197 IF( lk_diaobs ) CALL dia_obs_wri 196 198 IF( nn_timing == 1 ) CALL timing_finalize 197 CALL Agrif_ChildGrid_To_ParentGrid()199 CALL Agrif_ChildGrid_To_ParentGrid() 198 200 ENDIF 199 201 #endif … … 203 205 ! 204 206 #if defined key_iomput 205 CALL xios_finalize ! end mpp communications with xios206 IF( lk_oasis ) CALL cpl_finalize! end coupling and mpp communications with OASIS207 CALL xios_finalize ! end mpp communications with xios 208 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 207 209 #else 208 210 IF( lk_oasis ) THEN … … 319 321 ! If dimensions of processor grid weren't specified in the namelist file 320 322 ! then we calculate them here now that we have our communicator size 321 IF( (jpni < 1) .OR. (jpnj < 1) )THEN323 IF( jpni < 1 .OR. jpnj < 1 ) THEN 322 324 #if defined key_mpp_mpi 323 IF( Agrif_Root() ) CALL nemo_partition(mppsize)325 IF( Agrif_Root() ) CALL nemo_partition( mppsize ) 324 326 #else 325 327 jpni = 1 … … 327 329 jpnij = jpni*jpnj 328 330 #endif 329 END 331 ENDIF 330 332 331 333 ! Calculate domain dimensions given calculated jpni and jpnj 332 ! This used to be done in par_oce.F90 when they were parameters rather 333 ! than variables 334 ! This used to be done in par_oce.F90 when they were parameters rather than variables 334 335 IF( Agrif_Root() ) THEN 335 336 #if defined key_nemocice_decomp 336 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim.337 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.337 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 338 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 338 339 #else 339 jpi = ( jpiglo -2*jpreci + (jpni-1) ) / jpni + 2*jpreci! first dim.340 jpj = ( jpjglo -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj! second dim.340 jpi = ( jpiglo -2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 341 jpj = ( jpjglo -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 341 342 #endif 342 343 ENDIF 343 344 jpk = jpkdta ! third dim 344 345 #if defined key_agrif 345 ! simple trick to use same vertical grid as parent 346 ! but different number of levels: 347 ! Save maximum number of levels in jpkdta, then define all vertical grids 348 ! with this number. 346 ! simple trick to use same vertical grid as parent but different number of levels: 347 ! Save maximum number of levels in jpkdta, then define all vertical grids with this number. 349 348 ! Suppress once vertical online interpolation is ok 350 IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent(jpkdta)349 IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent( jpkdta ) 351 350 #endif 352 351 jpim1 = jpi-1 ! inner domain indices … … 363 362 WRITE(numout,*) ' NEMO team' 364 363 WRITE(numout,*) ' Ocean General Circulation Model' 365 WRITE(numout,*) ' version 3. 6(2015) '364 WRITE(numout,*) ' version 3.7 (2015) ' 366 365 WRITE(numout,*) 367 366 WRITE(numout,*) … … 396 395 CALL dom_cfg ! Domain configuration 397 396 CALL dom_init ! Domain 398 399 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 400 397 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization 398 IF( ln_nnogather ) CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined) 401 399 IF( ln_ctl ) CALL prt_ctl_init ! Print control 402 403 400 CALL istate_init ! ocean initial state (Dynamics and tracers) 404 401 405 IF( lk_tide ) CALL tide_init( nit000 ) ! Initialisation of the tidal harmonics 406 407 CALL sbc_init ! Forcings : surface module (clem: moved here for bdy purpose) 408 402 ! ! external forcing 403 !!gm to be added : creation and call of sbc_apr_init 404 IF( lk_tide ) CALL tide_init( nit000 ) ! tidal harmonics 405 CALL sbc_init ! surface boundary conditions (including sea-ice) 406 !!gm ==>> bdy_init should call bdy_dta_init and bdytide_init NOT in nemogcm !!! 409 407 IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation 410 408 IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays 411 409 IF( lk_bdy .AND. lk_tide ) & 412 410 & CALL bdytide_init ! Open boundaries initialisation of tidal harmonic forcing 413 414 CALL dyn_nept_init ! simplified form of Neptune effect 415 ! 416 IF( ln_crs ) CALL crs_init ! Domain initialization of coarsened grid 417 ! 418 ! Ocean physics 411 412 ! ! Ocean physics 419 413 ! ! Vertical physics 420 414 CALL zdf_init ! namelist read … … 423 417 IF( lk_zdftke ) CALL zdf_tke_init ! TKE closure scheme 424 418 IF( lk_zdfgls ) CALL zdf_gls_init ! GLS closure scheme 425 IF( lk_zdfkpp ) CALL zdf_kpp_init ! KPP closure scheme426 419 IF( lk_zdftmx ) CALL zdf_tmx_init ! tidal vertical mixing 427 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) &428 & CALL zdf_ddm_init ! double diffusive mixing420 IF( lk_zdfddm ) CALL zdf_ddm_init ! double diffusive mixing 421 429 422 ! ! Lateral physics 430 423 CALL ldf_tra_init ! Lateral ocean tracer physics 424 CALL ldf_eiv_init ! eddy induced velocity param. 431 425 CALL ldf_dyn_init ! Lateral ocean momentum physics 432 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 433 434 ! ! Active tracers 435 CALL tra_qsr_init ! penetrative solar radiation qsr 436 CALL tra_bbc_init ! bottom heat flux 437 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 438 CALL tra_dmp_init ! internal damping trends- tracers 439 CALL tra_adv_init ! horizontal & vertical advection 440 CALL tra_ldf_init ! lateral mixing 441 CALL tra_zdf_init ! vertical mixing and after tracer fields 442 443 ! ! Dynamics 444 IF( lk_c1d ) CALL dyn_dmp_init ! internal damping trends- momentum 445 CALL dyn_adv_init ! advection (vector or flux form) 446 CALL dyn_vor_init ! vorticity term including Coriolis 447 CALL dyn_ldf_init ! lateral mixing 448 CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure 449 CALL dyn_zdf_init ! vertical diffusion 450 CALL dyn_spg_init ! surface pressure gradient 451 452 ! ! Misc. options 453 IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 ) CALL cla_init ! Cross Land Advection 426 427 ! ! Active tracers 428 CALL tra_qsr_init ! penetrative solar radiation qsr 429 CALL tra_bbc_init ! bottom heat flux 430 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 431 CALL tra_dmp_init ! internal tracer damping 432 CALL tra_adv_init ! horizontal & vertical advection 433 CALL tra_ldf_init ! lateral mixing 434 CALL tra_zdf_init ! vertical mixing and after tracer fields 435 436 ! ! Dynamics 437 IF( lk_c1d ) CALL dyn_dmp_init ! internal momentum damping 438 CALL dyn_adv_init ! advection (vector or flux form) 439 CALL dyn_vor_init ! vorticity term including Coriolis 440 CALL dyn_ldf_init ! lateral mixing 441 CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure 442 CALL dyn_zdf_init ! vertical diffusion 443 CALL dyn_spg_init ! surface pressure gradient 444 445 #if defined key_top 446 ! ! Passive tracers 447 CALL trc_init 448 #endif 449 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 450 451 ! ! Icebergs 454 452 CALL icb_init( rdt, nit000) ! initialise icebergs instance 453 454 ! ! Misc. options 455 455 CALL sto_par_init ! Stochastic parametrization 456 456 IF( ln_sto_eos ) CALL sto_pts_init ! RRandom T/S fluctuations 457 457 458 #if defined key_top 459 ! ! Passive tracers 460 CALL trc_init 461 #endif 462 ! ! Diagnostics 458 ! ! Diagnostics 463 459 IF( lk_floats ) CALL flo_init ! drifting Floats 464 460 IF( lk_diaar5 ) CALL dia_ar5_init ! ar5 diag … … 471 467 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 472 468 ENDIF 473 474 ! ! Assimilation increments 469 ! ! Assimilation increments 475 470 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 476 471 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler … … 519 514 WRITE(numout,*) '~~~~~~~ ' 520 515 WRITE(numout,*) ' Namelist namcfg' 521 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_cfg524 WRITE(numout,*) ' 1st lateral dimension ( >= jpi ) jpidta= ', jpidta525 WRITE(numout,*) ' 2nd " " ( >= jpj ) jpjdta= ', jpjdta526 WRITE(numout,*) ' 3nd " " jpkdta= ', jpkdta527 WRITE(numout,*) ' 1st dimension of global domain in i jpiglo = ', jpiglo528 WRITE(numout,*) ' 2nd - - in j jpjglo = ', jpjglo516 WRITE(numout,*) ' configuration name cp_cfg = ', TRIM(cp_cfg) 517 WRITE(numout,*) ' configuration zoom name cp_cfz = ', TRIM(cp_cfz) 518 WRITE(numout,*) ' configuration resolution jp_cfg = ', jp_cfg 519 WRITE(numout,*) ' 1st lateral dimension ( >= jpiglo ) jpidta = ', jpidta 520 WRITE(numout,*) ' 2nd " " ( >= jpjglo ) jpjdta = ', jpjdta 521 WRITE(numout,*) ' 3nd " " jpkdta = ', jpkdta 522 WRITE(numout,*) ' 1st dimension of global domain in i jpiglo = ', jpiglo 523 WRITE(numout,*) ' 2nd - - in j jpjglo = ', jpjglo 529 524 WRITE(numout,*) ' left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 530 525 WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 531 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio= ', jperio526 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio 532 527 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 533 528 ENDIF … … 610 605 IF( numdct_heat /= -1 ) CLOSE( numdct_heat ) ! heat transports 611 606 IF( numdct_salt /= -1 ) CLOSE( numdct_salt ) ! salt transports 612 613 607 ! 614 608 numout = 6 ! redefine numout in case it is used after this point... … … 627 621 USE diawri , ONLY: dia_wri_alloc 628 622 USE dom_oce , ONLY: dom_oce_alloc 629 USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc630 USE ldftra_oce, ONLY: ldftra_oce_alloc631 623 USE trc_oce , ONLY: trc_oce_alloc 632 624 #if defined key_diadct … … 643 635 ierr = ierr + dia_wri_alloc () 644 636 ierr = ierr + dom_oce_alloc () ! ocean domain 645 ierr = ierr + ldfdyn_oce_alloc() ! ocean lateral physics : dynamics646 ierr = ierr + ldftra_oce_alloc() ! ocean lateral physics : tracers647 637 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 648 638 ! … … 724 714 INTEGER :: ifac, jl, inu 725 715 INTEGER, PARAMETER :: ntest = 14 726 INTEGER, DIMENSION(ntest) :: ilfax 727 !!---------------------------------------------------------------------- 716 INTEGER, DIMENSION(ntest) :: ilfax 717 !!---------------------------------------------------------------------- 718 ! 728 719 ! lfax contains the set of allowed factors. 729 720 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 730 721 ! 731 722 ! Clear the error flag and initialise output vars 732 kerr = 0733 kfax = 1723 kerr = 0 724 kfax = 1 734 725 knfax = 0 735 726 ! 736 727 ! Find the factors of n. 737 728 IF( kn == 1 ) GOTO 20 … … 741 732 ! l points to the allowed factor list. 742 733 ! ifac holds the current factor. 743 734 ! 744 735 inu = kn 745 736 knfax = 0 746 737 ! 747 738 DO jl = ntest, 1, -1 748 739 ! … … 768 759 ! 769 760 END DO 770 761 ! 771 762 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 772 763 ! … … 776 767 777 768 SUBROUTINE nemo_northcomms 778 !! ======================================================================769 !!---------------------------------------------------------------------- 779 770 !! *** ROUTINE nemo_northcomms *** 780 !! nemo_northcomms : Setup for north fold exchanges with explicit 781 !! point-to-point messaging 782 !!===================================================================== 783 !!---------------------------------------------------------------------- 784 !! 785 !! ** Purpose : Initialization of the northern neighbours lists. 771 !! ** Purpose : Setup for north fold exchanges with explicit 772 !! point-to-point messaging 773 !! 774 !! ** Method : Initialization of the northern neighbours lists. 786 775 !!---------------------------------------------------------------------- 787 776 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 788 777 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 789 778 !!---------------------------------------------------------------------- 790 791 779 INTEGER :: sxM, dxM, sxT, dxT, jn 792 780 INTEGER :: njmppmax 793 781 !!---------------------------------------------------------------------- 782 ! 794 783 njmppmax = MAXVAL( njmppt ) 795 784 ! 796 785 !initializes the north-fold communication variables 797 786 isendto(:) = 0 798 nsndto = 0799 787 nsndto = 0 788 ! 800 789 !if I am a process in the north 801 790 IF ( njmpp == njmppmax ) THEN … … 844 833 l_north_nogather = .TRUE. 845 834 END SUBROUTINE nemo_northcomms 835 846 836 #else 847 837 SUBROUTINE nemo_northcomms ! Dummy routine … … 853 843 END MODULE nemogcm 854 844 855
Note: See TracChangeset
for help on using the changeset viewer.
