- Timestamp:
- 2015-11-30T11:47:24+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r5947 r5948 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) … … 78 80 USE lib_mpp ! distributed memory computing 79 81 #if defined key_iomput 80 USE xios 81 #endif 82 USE sbctide, ONLY : lk_tide82 USE xios ! xIOserver 83 #endif 84 USE sbctide, ONLY : lk_tide 83 85 USE crsini ! initialise grid coarsening utility 84 USE lbcnfd , ONLY: isendto, nsndto, nfsloop, nfeloop! Setup of north fold exchanges85 USE sbc_oce, ONLY : lk_oasis86 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 87 USE sbc_oce, ONLY : lk_oasis 86 88 USE stopar 87 89 USE stopts … … 97 99 98 100 !!---------------------------------------------------------------------- 99 !! NEMO/OPA 4.0 , NEMO Consortium (2011)101 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 100 102 !! $Id$ 101 103 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 162 164 ENDIF 163 165 166 #if defined key_agrif 167 CALL Agrif_Regrid() 168 #endif 169 164 170 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 165 171 #if defined key_agrif 166 CALL Agrif_Step( stp )! AGRIF: time stepping172 CALL stp ! AGRIF: time stepping 167 173 #else 168 174 CALL stp( istp ) ! standard time stepping … … 188 194 ! 189 195 #if defined key_agrif 190 CALL Agrif_ParentGrid_To_ChildGrid() 191 IF( lk_diaobs ) CALL dia_obs_wri 196 IF(.NOT.Agrif_Root() ) THEN 197 CALL Agrif_ParentGrid_To_ChildGrid() 198 IF( lk_diaobs ) CALL dia_obs_wri 199 IF( nn_timing == 1 ) CALL timing_finalize 200 CALL Agrif_ChildGrid_To_ParentGrid() 201 ENDIF 202 #endif 192 203 IF( nn_timing == 1 ) CALL timing_finalize 193 CALL Agrif_ChildGrid_To_ParentGrid()194 #endif195 IF( nn_timing == 1 ) CALL timing_finalize196 204 ! 197 205 CALL nemo_closefile 198 206 ! 199 207 #if defined key_iomput 200 CALL xios_finalize ! end mpp communications with xios201 IF( lk_oasis ) CALL cpl_finalize! end coupling and mpp communications with OASIS208 CALL xios_finalize ! end mpp communications with xios 209 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 202 210 #else 203 211 IF( lk_oasis ) THEN … … 314 322 ! If dimensions of processor grid weren't specified in the namelist file 315 323 ! then we calculate them here now that we have our communicator size 316 IF( (jpni < 1) .OR. (jpnj < 1) )THEN324 IF( jpni < 1 .OR. jpnj < 1 ) THEN 317 325 #if defined key_mpp_mpi 318 IF( Agrif_Root() ) CALL nemo_partition(mppsize)326 IF( Agrif_Root() ) CALL nemo_partition( mppsize ) 319 327 #else 320 328 jpni = 1 … … 322 330 jpnij = jpni*jpnj 323 331 #endif 324 END 332 ENDIF 325 333 326 334 ! Calculate domain dimensions given calculated jpni and jpnj 327 ! This used to be done in par_oce.F90 when they were parameters rather 328 ! than variables 335 ! This used to be done in par_oce.F90 when they were parameters rather than variables 329 336 IF( Agrif_Root() ) THEN 330 337 #if defined key_nemocice_decomp 331 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim.332 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.338 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 339 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 333 340 #else 334 jpi = ( jpiglo -2*jpreci + (jpni-1) ) / jpni + 2*jpreci! first dim.335 jpj = ( jpjglo -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj! second dim.336 #endif 337 ENDIF 341 jpi = ( jpiglo -2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 342 jpj = ( jpjglo -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 343 #endif 344 ENDIF 338 345 jpk = jpkdta ! third dim 346 #if defined key_agrif 347 ! simple trick to use same vertical grid as parent but different number of levels: 348 ! Save maximum number of levels in jpkdta, then define all vertical grids with this number. 349 ! Suppress once vertical online interpolation is ok 350 IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent( jpkdta ) 351 #endif 339 352 jpim1 = jpi-1 ! inner domain indices 340 353 jpjm1 = jpj-1 ! " " … … 350 363 WRITE(numout,*) ' NEMO team' 351 364 WRITE(numout,*) ' Ocean General Circulation Model' 352 WRITE(numout,*) ' version 3. 6(2015) '365 WRITE(numout,*) ' version 3.7 (2015) ' 353 366 WRITE(numout,*) 354 367 WRITE(numout,*) … … 383 396 CALL dom_cfg ! Domain configuration 384 397 CALL dom_init ! Domain 385 386 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 387 398 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization 399 IF( ln_nnogather ) CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined) 388 400 IF( ln_ctl ) CALL prt_ctl_init ! Print control 389 390 401 CALL istate_init ! ocean initial state (Dynamics and tracers) 391 402 392 IF( lk_tide ) CALL tide_init( nit000 ) ! Initialisation of the tidal harmonics 393 394 CALL sbc_init ! Forcings : surface module (clem: moved here for bdy purpose) 395 403 ! ! external forcing 404 !!gm to be added : creation and call of sbc_apr_init 405 IF( lk_tide ) CALL tide_init( nit000 ) ! tidal harmonics 406 CALL sbc_init ! surface boundary conditions (including sea-ice) 407 !!gm ==>> bdy_init should call bdy_dta_init and bdytide_init NOT in nemogcm !!! 396 408 IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation 397 409 IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays 398 410 IF( lk_bdy .AND. lk_tide ) & 399 411 & CALL bdytide_init ! Open boundaries initialisation of tidal harmonic forcing 400 401 CALL dyn_nept_init ! simplified form of Neptune effect 402 ! 403 IF( ln_crs ) CALL crs_init ! Domain initialization of coarsened grid 404 ! 405 ! Ocean physics 412 413 ! ! Ocean physics 406 414 ! ! Vertical physics 407 415 CALL zdf_init ! namelist read … … 410 418 IF( lk_zdftke ) CALL zdf_tke_init ! TKE closure scheme 411 419 IF( lk_zdfgls ) CALL zdf_gls_init ! GLS closure scheme 412 IF( lk_zdfkpp ) CALL zdf_kpp_init ! KPP closure scheme413 420 IF( lk_zdftmx ) CALL zdf_tmx_init ! tidal vertical mixing 414 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) &415 & CALL zdf_ddm_init ! double diffusive mixing421 IF( lk_zdfddm ) CALL zdf_ddm_init ! double diffusive mixing 422 416 423 ! ! Lateral physics 417 424 CALL ldf_tra_init ! Lateral ocean tracer physics 425 CALL ldf_eiv_init ! eddy induced velocity param. 418 426 CALL ldf_dyn_init ! Lateral ocean momentum physics 419 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 420 421 ! ! Active tracers 422 CALL tra_qsr_init ! penetrative solar radiation qsr 423 CALL tra_bbc_init ! bottom heat flux 424 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 425 CALL tra_dmp_init ! internal damping trends- tracers 426 CALL tra_adv_init ! horizontal & vertical advection 427 CALL tra_ldf_init ! lateral mixing 428 CALL tra_zdf_init ! vertical mixing and after tracer fields 429 430 ! ! Dynamics 431 IF( lk_c1d ) CALL dyn_dmp_init ! internal damping trends- momentum 432 CALL dyn_adv_init ! advection (vector or flux form) 433 CALL dyn_vor_init ! vorticity term including Coriolis 434 CALL dyn_ldf_init ! lateral mixing 435 CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure 436 CALL dyn_zdf_init ! vertical diffusion 437 CALL dyn_spg_init ! surface pressure gradient 438 439 ! ! Misc. options 440 IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 ) CALL cla_init ! Cross Land Advection 427 428 ! ! Active tracers 429 CALL tra_qsr_init ! penetrative solar radiation qsr 430 CALL tra_bbc_init ! bottom heat flux 431 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 432 CALL tra_dmp_init ! internal tracer damping 433 CALL tra_adv_init ! horizontal & vertical advection 434 CALL tra_ldf_init ! lateral mixing 435 CALL tra_zdf_init ! vertical mixing and after tracer fields 436 437 ! ! Dynamics 438 IF( lk_c1d ) CALL dyn_dmp_init ! internal momentum damping 439 CALL dyn_adv_init ! advection (vector or flux form) 440 CALL dyn_vor_init ! vorticity term including Coriolis 441 CALL dyn_ldf_init ! lateral mixing 442 CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure 443 CALL dyn_zdf_init ! vertical diffusion 444 CALL dyn_spg_init ! surface pressure gradient 445 446 #if defined key_top 447 ! ! Passive tracers 448 CALL trc_init 449 #endif 450 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 451 452 ! ! Icebergs 441 453 CALL icb_init( rdt, nit000) ! initialise icebergs instance 454 455 ! ! Misc. options 442 456 CALL sto_par_init ! Stochastic parametrization 443 457 IF( ln_sto_eos ) CALL sto_pts_init ! RRandom T/S fluctuations 444 458 445 #if defined key_top 446 ! ! Passive tracers 447 CALL trc_init 448 #endif 449 ! ! Diagnostics 459 ! ! Diagnostics 450 460 IF( lk_floats ) CALL flo_init ! drifting Floats 451 461 CALL dia_cfl_init ! Initialise CFL diagnostics … … 459 469 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 460 470 ENDIF 461 462 ! ! Assimilation increments 471 ! ! Assimilation increments 463 472 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 464 473 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler … … 507 516 WRITE(numout,*) '~~~~~~~ ' 508 517 WRITE(numout,*) ' Namelist namcfg' 509 WRITE(numout,*) ' configuration name cp_cfg= ', TRIM(cp_cfg)510 WRITE(numout,*) ' configuration zoom name cp_cfz= ', TRIM(cp_cfz)511 WRITE(numout,*) ' configuration resolution jp_cfg= ', jp_cfg512 WRITE(numout,*) ' 1st lateral dimension ( >= jpi ) jpidta= ', jpidta513 WRITE(numout,*) ' 2nd " " ( >= jpj ) jpjdta= ', jpjdta514 WRITE(numout,*) ' 3nd " " jpkdta= ', jpkdta515 WRITE(numout,*) ' 1st dimension of global domain in i jpiglo = ', jpiglo516 WRITE(numout,*) ' 2nd - - in j jpjglo = ', jpjglo518 WRITE(numout,*) ' configuration name cp_cfg = ', TRIM(cp_cfg) 519 WRITE(numout,*) ' configuration zoom name cp_cfz = ', TRIM(cp_cfz) 520 WRITE(numout,*) ' configuration resolution jp_cfg = ', jp_cfg 521 WRITE(numout,*) ' 1st lateral dimension ( >= jpiglo ) jpidta = ', jpidta 522 WRITE(numout,*) ' 2nd " " ( >= jpjglo ) jpjdta = ', jpjdta 523 WRITE(numout,*) ' 3nd " " jpkdta = ', jpkdta 524 WRITE(numout,*) ' 1st dimension of global domain in i jpiglo = ', jpiglo 525 WRITE(numout,*) ' 2nd - - in j jpjglo = ', jpjglo 517 526 WRITE(numout,*) ' left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 518 527 WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 519 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio= ', jperio528 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio 520 529 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 521 530 ENDIF … … 598 607 IF( numdct_heat /= -1 ) CLOSE( numdct_heat ) ! heat transports 599 608 IF( numdct_salt /= -1 ) CLOSE( numdct_salt ) ! salt transports 600 601 609 ! 602 610 numout = 6 ! redefine numout in case it is used after this point... … … 615 623 USE diawri , ONLY: dia_wri_alloc 616 624 USE dom_oce , ONLY: dom_oce_alloc 617 USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc618 USE ldftra_oce, ONLY: ldftra_oce_alloc619 625 USE trc_oce , ONLY: trc_oce_alloc 620 626 #if defined key_diadct … … 631 637 ierr = ierr + dia_wri_alloc () 632 638 ierr = ierr + dom_oce_alloc () ! ocean domain 633 ierr = ierr + ldfdyn_oce_alloc() ! ocean lateral physics : dynamics634 ierr = ierr + ldftra_oce_alloc() ! ocean lateral physics : tracers635 639 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 636 640 ! … … 712 716 INTEGER :: ifac, jl, inu 713 717 INTEGER, PARAMETER :: ntest = 14 714 INTEGER :: ilfax(ntest) 718 INTEGER, DIMENSION(ntest) :: ilfax 719 !!---------------------------------------------------------------------- 715 720 ! 716 721 ! lfax contains the set of allowed factors. 717 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & 718 & 128, 64, 32, 16, 8, 4, 2 / 719 !!---------------------------------------------------------------------- 720 722 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 723 ! 721 724 ! Clear the error flag and initialise output vars 722 kerr = 0723 kfax = 1725 kerr = 0 726 kfax = 1 724 727 knfax = 0 725 728 ! 726 729 ! Find the factors of n. 727 730 IF( kn == 1 ) GOTO 20 … … 731 734 ! l points to the allowed factor list. 732 735 ! ifac holds the current factor. 733 736 ! 734 737 inu = kn 735 738 knfax = 0 736 739 ! 737 740 DO jl = ntest, 1, -1 738 741 ! … … 758 761 ! 759 762 END DO 760 763 ! 761 764 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 762 765 ! … … 766 769 767 770 SUBROUTINE nemo_northcomms 768 !! ======================================================================771 !!---------------------------------------------------------------------- 769 772 !! *** ROUTINE nemo_northcomms *** 770 !! nemo_northcomms : Setup for north fold exchanges with explicit 771 !! point-to-point messaging 772 !!===================================================================== 773 !!---------------------------------------------------------------------- 774 !! 775 !! ** Purpose : Initialization of the northern neighbours lists. 773 !! ** Purpose : Setup for north fold exchanges with explicit 774 !! point-to-point messaging 775 !! 776 !! ** Method : Initialization of the northern neighbours lists. 776 777 !!---------------------------------------------------------------------- 777 778 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 778 779 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 779 780 !!---------------------------------------------------------------------- 780 781 781 INTEGER :: sxM, dxM, sxT, dxT, jn 782 782 INTEGER :: njmppmax 783 783 !!---------------------------------------------------------------------- 784 ! 784 785 njmppmax = MAXVAL( njmppt ) 785 786 ! 786 787 !initializes the north-fold communication variables 787 788 isendto(:) = 0 788 nsndto = 0789 789 nsndto = 0 790 ! 790 791 !if I am a process in the north 791 792 IF ( njmpp == njmppmax ) THEN … … 834 835 l_north_nogather = .TRUE. 835 836 END SUBROUTINE nemo_northcomms 837 836 838 #else 837 839 SUBROUTINE nemo_northcomms ! Dummy routine … … 843 845 END MODULE nemogcm 844 846 845
Note: See TracChangeset
for help on using the changeset viewer.
