- Timestamp:
- 2016-07-19T10:38:35+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r5536 r6808 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 34 37 !!---------------------------------------------------------------------- 35 !! nemo_gcm 36 !! nemo_init 37 !! nemo_ctl 38 !! nemo_closefile 39 !! nemo_alloc 40 !! nemo_partition 41 !! factorise 38 !! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 39 !! nemo_init : initialization of the NEMO system 40 !! nemo_ctl : initialisation of the contol print 41 !! nemo_closefile: close remaining open files 42 !! nemo_alloc : dynamical allocation 43 !! nemo_partition: calculate MPP domain decomposition 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) 45 USE domcfg ! domain configuration (dom_cfg routine) 46 USE mppini ! shared/distributed memory setting (mpp_init routine) 47 USE domain ! domain initialization (dom_init routine) 46 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) 48 50 #if defined key_nemocice_decomp 49 51 USE ice_domain_size, only: nx_global, ny_global 50 52 #endif 51 USE tideini ! tidal components initialization (tide_ini routine) 52 USE bdyini ! open boundary cond. setting (bdy_init routine) 53 USE bdydta ! open boundary cond. setting (bdy_dta_init routine) 54 USE bdytides ! open boundary cond. setting (bdytide_init routine) 55 USE istate ! initial state setting (istate_init routine) 56 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) 57 USE ldftra ! lateral diffusivity setting (ldftra_init routine) 58 USE zdfini ! vertical physics setting (zdf_init routine) 59 USE phycst ! physical constant (par_cst routine) 60 USE trdini ! dyn/tra trends initialization (trd_init routine) 61 USE asminc ! assimilation increments 62 USE asmbkg ! writing out state trajectory 63 USE diaptr ! poleward transports (dia_ptr_init routine) 64 USE diadct ! sections transports (dia_dct_init routine) 65 USE diaobs ! Observation diagnostics (dia_obs_init routine) 66 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 67 USE step ! NEMO time-stepping (stp routine) 68 USE icbini ! handle bergs, initialisation 69 USE icbstp ! handle bergs, calving, themodynamics and transport 70 USE cpl_oasis3 ! OASIS3 coupling 71 USE c1d ! 1D configuration 72 USE step_c1d ! Time stepping loop for the 1D configuration 73 USE dyndmp ! Momentum damping 53 USE tideini ! tidal components initialization (tide_ini routine) 54 USE bdyini ! open boundary cond. setting (bdy_init routine) 55 USE bdydta ! open boundary cond. setting (bdy_dta_init routine) 56 USE bdytides ! open boundary cond. setting (bdytide_init routine) 57 USE sbctide, ONLY : lk_tide 58 USE istate ! initial state setting (istate_init routine) 59 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) 60 USE ldftra ! lateral diffusivity setting (ldftra_init routine) 61 USE zdfini ! vertical physics setting (zdf_init routine) 62 USE phycst ! physical constant (par_cst routine) 63 USE trdini ! dyn/tra trends initialization (trd_init routine) 64 USE asminc ! assimilation increments 65 USE asmbkg ! writing out state trajectory 66 USE diaptr ! poleward transports (dia_ptr_init routine) 67 USE diadct ! sections transports (dia_dct_init routine) 68 USE diaobs ! Observation diagnostics (dia_obs_init routine) 69 USE diacfl ! CFL diagnostics (dia_cfl_init routine) 70 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 71 USE step ! NEMO time-stepping (stp routine) 72 USE icbini ! handle bergs, initialisation 73 USE icbstp ! handle bergs, calving, themodynamics and transport 74 USE cpl_oasis3 ! OASIS3 coupling 75 USE c1d ! 1D configuration 76 USE step_c1d ! Time stepping loop for the 1D configuration 77 USE dyndmp ! Momentum damping 78 USE stopar ! Stochastic param.: ??? 79 USE stopts ! Stochastic param.: ??? 74 80 #if defined key_top 75 USE trcini ! passive tracer initialisation 76 #endif 77 USE lib_mpp ! distributed memory computing 81 USE trcini ! passive tracer initialisation 82 #endif 83 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) 78 86 #if defined key_iomput 79 USE xios 80 #endif 81 USE sbctide, ONLY: lk_tide82 USE crsini ! initialise grid coarsening utility83 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges84 USE sbc_oce, ONLY: lk_oasis85 USE stopar86 USE stopts87 USE xios ! xIOserver 88 #endif 89 USE crsini ! initialise grid coarsening utility 90 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 91 USE sbc_oce, ONLY : lk_oasis 92 USE diatmb ! Top,middle,bottom output 93 USE dia25h ! 25h mean output 94 USE wet_dry ! Wetting and drying setting (wad_init routine) 87 95 88 96 IMPLICIT NONE … … 96 104 97 105 !!---------------------------------------------------------------------- 98 !! NEMO/OPA 4.0 , NEMO Consortium (2011)106 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 99 107 !! $Id$ 100 108 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 161 169 ENDIF 162 170 171 #if defined key_agrif 172 CALL Agrif_Regrid() 173 #endif 174 163 175 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 164 176 #if defined key_agrif 165 CALL Agrif_Step( stp )! AGRIF: time stepping177 CALL stp ! AGRIF: time stepping 166 178 #else 167 CALL stp( istp ) ! standard time stepping 179 IF ( .NOT. ln_diurnal_only ) THEN 180 CALL stp( istp ) ! standard time stepping 181 ELSE 182 CALL stp_diurnal( istp ) ! time step only the diurnal SST 183 ENDIF 168 184 #endif 169 185 istp = istp + 1 … … 172 188 #endif 173 189 174 IF( l k_diaobs ) CALL dia_obs_wri190 IF( ln_diaobs ) CALL dia_obs_wri 175 191 ! 176 192 IF( ln_icebergs ) CALL icb_end( nitend ) … … 187 203 ! 188 204 #if defined key_agrif 189 IF ( Agrif_Level() < Agrif_MaxLevel() ) THEN190 CALL Agrif_ParentGrid_To_ChildGrid()191 IF( l k_diaobs ) CALL dia_obs_wri205 IF( .NOT. Agrif_Root() ) THEN 206 CALL Agrif_ParentGrid_To_ChildGrid() 207 IF( ln_diaobs ) CALL dia_obs_wri 192 208 IF( nn_timing == 1 ) CALL timing_finalize 193 CALL Agrif_ChildGrid_To_ParentGrid()209 CALL Agrif_ChildGrid_To_ParentGrid() 194 210 ENDIF 195 211 #endif … … 199 215 ! 200 216 #if defined key_iomput 201 CALL xios_finalize ! end mpp communications with xios202 IF( lk_oasis ) CALL cpl_finalize! end coupling and mpp communications with OASIS217 CALL xios_finalize ! end mpp communications with xios 218 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 203 219 #else 204 220 IF( lk_oasis ) THEN … … 225 241 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 226 242 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, & 227 & nn_bench, nn_timing 243 & nn_bench, nn_timing, nn_diacfl 228 244 NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 229 245 & jpizoom, jpjzoom, jperio, ln_use_jattr … … 315 331 ! If dimensions of processor grid weren't specified in the namelist file 316 332 ! then we calculate them here now that we have our communicator size 317 IF( (jpni < 1) .OR. (jpnj < 1) )THEN333 IF( jpni < 1 .OR. jpnj < 1 ) THEN 318 334 #if defined key_mpp_mpi 319 IF( Agrif_Root() ) CALL nemo_partition(mppsize)335 IF( Agrif_Root() ) CALL nemo_partition( mppsize ) 320 336 #else 321 337 jpni = 1 … … 323 339 jpnij = jpni*jpnj 324 340 #endif 325 END 341 ENDIF 326 342 327 343 ! Calculate domain dimensions given calculated jpni and jpnj 328 ! This used to be done in par_oce.F90 when they were parameters rather 329 ! than variables 344 ! This used to be done in par_oce.F90 when they were parameters rather than variables 330 345 IF( Agrif_Root() ) THEN 331 346 #if defined key_nemocice_decomp 332 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim.333 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.347 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 348 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 334 349 #else 335 jpi = ( jpiglo -2*jpreci + (jpni-1) ) / jpni + 2*jpreci! first dim.336 jpj = ( jpjglo -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj! second dim.337 #endif 338 ENDIF 350 jpi = ( jpiglo -2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 351 jpj = ( jpjglo -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 352 #endif 353 ENDIF 339 354 jpk = jpkdta ! third dim 355 #if defined key_agrif 356 ! simple trick to use same vertical grid as parent but different number of levels: 357 ! Save maximum number of levels in jpkdta, then define all vertical grids with this number. 358 ! Suppress once vertical online interpolation is ok 359 IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent( jpkdta ) 360 #endif 340 361 jpim1 = jpi-1 ! inner domain indices 341 362 jpjm1 = jpj-1 ! " " … … 351 372 WRITE(numout,*) ' NEMO team' 352 373 WRITE(numout,*) ' Ocean General Circulation Model' 353 WRITE(numout,*) ' version 3. 6(2015) '374 WRITE(numout,*) ' version 3.7 (2015) ' 354 375 WRITE(numout,*) 355 376 WRITE(numout,*) … … 382 403 CALL eos_init ! Equation of state 383 404 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 405 CALL wad_init ! Wetting and drying options 384 406 CALL dom_cfg ! Domain configuration 385 407 CALL dom_init ! Domain 386 387 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 388 408 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization 409 IF( ln_nnogather ) CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined) 389 410 IF( ln_ctl ) CALL prt_ctl_init ! Print control 390 411 412 CALL diurnal_sst_bulk_init ! diurnal sst 413 IF ( ln_diurnal ) CALL diurnal_sst_coolskin_init ! cool skin 414 415 ! IF ln_diurnal_only, then we only want a subset of the initialisation routines 416 IF ( ln_diurnal_only ) THEN 417 CALL istate_init ! ocean initial state (Dynamics and tracers) 418 CALL sbc_init ! Forcings : surface module 419 CALL tra_qsr_init ! penetrative solar radiation qsr 420 IF( ln_diaobs ) THEN ! Observation & model comparison 421 CALL dia_obs_init ! Initialize observational data 422 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 423 ENDIF 424 ! ! Assimilation increments 425 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 426 427 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 428 RETURN 429 ENDIF 430 391 431 CALL istate_init ! ocean initial state (Dynamics and tracers) 392 432 393 IF( lk_tide ) CALL tide_init( nit000 ) ! Initialisation of the tidal harmonics 394 395 CALL sbc_init ! Forcings : surface module (clem: moved here for bdy purpose) 396 433 ! ! external forcing 434 !!gm to be added : creation and call of sbc_apr_init 435 IF( lk_tide ) CALL tide_init ! tidal harmonics 436 CALL sbc_init ! surface boundary conditions (including sea-ice) 437 !!gm ==>> bdy_init should call bdy_dta_init and bdytide_init NOT in nemogcm !!! 397 438 IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation 398 439 IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays 399 440 IF( lk_bdy .AND. lk_tide ) & 400 441 & CALL bdytide_init ! Open boundaries initialisation of tidal harmonic forcing 401 402 CALL dyn_nept_init ! simplified form of Neptune effect 403 ! 404 IF( ln_crs ) CALL crs_init ! Domain initialization of coarsened grid 405 ! 406 ! Ocean physics 442 443 ! ! Ocean physics 407 444 ! ! Vertical physics 408 445 CALL zdf_init ! namelist read … … 411 448 IF( lk_zdftke ) CALL zdf_tke_init ! TKE closure scheme 412 449 IF( lk_zdfgls ) CALL zdf_gls_init ! GLS closure scheme 413 IF( lk_zdfkpp ) CALL zdf_kpp_init ! KPP closure scheme414 450 IF( lk_zdftmx ) CALL zdf_tmx_init ! tidal vertical mixing 415 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) &416 & CALL zdf_ddm_init ! double diffusive mixing451 IF( lk_zdfddm ) CALL zdf_ddm_init ! double diffusive mixing 452 417 453 ! ! Lateral physics 418 454 CALL ldf_tra_init ! Lateral ocean tracer physics 455 CALL ldf_eiv_init ! eddy induced velocity param. 419 456 CALL ldf_dyn_init ! Lateral ocean momentum physics 420 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 421 422 ! ! Active tracers 423 CALL tra_qsr_init ! penetrative solar radiation qsr 424 CALL tra_bbc_init ! bottom heat flux 425 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 426 CALL tra_dmp_init ! internal damping trends- tracers 427 CALL tra_adv_init ! horizontal & vertical advection 428 CALL tra_ldf_init ! lateral mixing 429 CALL tra_zdf_init ! vertical mixing and after tracer fields 430 431 ! ! Dynamics 432 IF( lk_c1d ) CALL dyn_dmp_init ! internal damping trends- momentum 433 CALL dyn_adv_init ! advection (vector or flux form) 434 CALL dyn_vor_init ! vorticity term including Coriolis 435 CALL dyn_ldf_init ! lateral mixing 436 CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure 437 CALL dyn_zdf_init ! vertical diffusion 438 CALL dyn_spg_init ! surface pressure gradient 439 440 ! ! Misc. options 441 IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 ) CALL cla_init ! Cross Land Advection 457 458 ! ! Active tracers 459 CALL tra_qsr_init ! penetrative solar radiation qsr 460 CALL tra_bbc_init ! bottom heat flux 461 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 462 CALL tra_dmp_init ! internal tracer damping 463 CALL tra_adv_init ! horizontal & vertical advection 464 CALL tra_ldf_init ! lateral mixing 465 CALL tra_zdf_init ! vertical mixing and after tracer fields 466 467 ! ! Dynamics 468 IF( lk_c1d ) CALL dyn_dmp_init ! internal momentum damping 469 CALL dyn_adv_init ! advection (vector or flux form) 470 CALL dyn_vor_init ! vorticity term including Coriolis 471 CALL dyn_ldf_init ! lateral mixing 472 CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure 473 CALL dyn_zdf_init ! vertical diffusion 474 CALL dyn_spg_init ! surface pressure gradient 475 476 #if defined key_top 477 ! ! Passive tracers 478 CALL trc_init 479 #endif 480 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 481 482 ! ! Icebergs 442 483 CALL icb_init( rdt, nit000) ! initialise icebergs instance 484 485 ! ! Misc. options 443 486 CALL sto_par_init ! Stochastic parametrization 444 487 IF( ln_sto_eos ) CALL sto_pts_init ! RRandom T/S fluctuations 445 488 446 #if defined key_top 447 ! ! Passive tracers 448 CALL trc_init 449 #endif 450 ! ! Diagnostics 489 ! ! Diagnostics 451 490 IF( lk_floats ) CALL flo_init ! drifting Floats 491 CALL dia_cfl_init ! Initialise CFL diagnostics 452 492 IF( lk_diaar5 ) CALL dia_ar5_init ! ar5 diag 453 493 CALL dia_ptr_init ! Poleward TRansports initialization … … 455 495 CALL dia_hsb_init ! heat content, salt content and volume budgets 456 496 CALL trd_init ! Mixed-layer/Vorticity/Integral constraints trends 457 IF( lk_diaobs ) THEN ! Observation & model comparison458 497 CALL dia_obs_init ! Initialize observational data 459 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 460 ENDIF 461 462 ! ! Assimilation increments 498 IF( ln_diaobs ) CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 499 500 ! ! Assimilation increments 463 501 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 464 502 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 503 CALL dia_tmb_init ! TMB outputs 504 CALL dia_25h_init ! 25h mean outputs 505 465 506 ! 466 507 END SUBROUTINE nemo_init … … 507 548 WRITE(numout,*) '~~~~~~~ ' 508 549 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 = ', jpjglo550 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 517 558 WRITE(numout,*) ' left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 518 559 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= ', jperio560 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio 520 561 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 521 562 ENDIF … … 598 639 IF( numdct_heat /= -1 ) CLOSE( numdct_heat ) ! heat transports 599 640 IF( numdct_salt /= -1 ) CLOSE( numdct_salt ) ! salt transports 600 601 641 ! 602 642 numout = 6 ! redefine numout in case it is used after this point... … … 615 655 USE diawri , ONLY: dia_wri_alloc 616 656 USE dom_oce , ONLY: dom_oce_alloc 617 USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc618 USE ldftra_oce, ONLY: ldftra_oce_alloc619 657 USE trc_oce , ONLY: trc_oce_alloc 620 658 #if defined key_diadct … … 631 669 ierr = ierr + dia_wri_alloc () 632 670 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 671 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 636 672 ! … … 712 748 INTEGER :: ifac, jl, inu 713 749 INTEGER, PARAMETER :: ntest = 14 714 INTEGER :: ilfax(ntest) 750 INTEGER, DIMENSION(ntest) :: ilfax 751 !!---------------------------------------------------------------------- 715 752 ! 716 753 ! 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 754 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 755 ! 721 756 ! Clear the error flag and initialise output vars 722 kerr = 0723 kfax = 1757 kerr = 0 758 kfax = 1 724 759 knfax = 0 725 760 ! 726 761 ! Find the factors of n. 727 762 IF( kn == 1 ) GOTO 20 … … 731 766 ! l points to the allowed factor list. 732 767 ! ifac holds the current factor. 733 768 ! 734 769 inu = kn 735 770 knfax = 0 736 771 ! 737 772 DO jl = ntest, 1, -1 738 773 ! … … 758 793 ! 759 794 END DO 760 795 ! 761 796 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 762 797 ! … … 766 801 767 802 SUBROUTINE nemo_northcomms 768 !! ======================================================================803 !!---------------------------------------------------------------------- 769 804 !! *** 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. 805 !! ** Purpose : Setup for north fold exchanges with explicit 806 !! point-to-point messaging 807 !! 808 !! ** Method : Initialization of the northern neighbours lists. 776 809 !!---------------------------------------------------------------------- 777 810 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 778 811 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 779 812 !!---------------------------------------------------------------------- 780 781 813 INTEGER :: sxM, dxM, sxT, dxT, jn 782 814 INTEGER :: njmppmax 783 815 !!---------------------------------------------------------------------- 816 ! 784 817 njmppmax = MAXVAL( njmppt ) 785 818 ! 786 819 !initializes the north-fold communication variables 787 820 isendto(:) = 0 788 nsndto = 0789 821 nsndto = 0 822 ! 790 823 !if I am a process in the north 791 824 IF ( njmpp == njmppmax ) THEN … … 834 867 l_north_nogather = .TRUE. 835 868 END SUBROUTINE nemo_northcomms 869 836 870 #else 837 871 SUBROUTINE nemo_northcomms ! Dummy routine … … 843 877 END MODULE nemogcm 844 878 845
Note: See TracChangeset
for help on using the changeset viewer.
