Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r2528 r2715 27 27 !! 3.3 ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 28 28 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 29 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 29 30 !!---------------------------------------------------------------------- 30 31 … … 34 35 !! nemo_ctl : initialisation of the contol print 35 36 !! nemo_closefile : close remaining open files 37 !! nemo_alloc : dynamical allocation 38 !! nemo_partition : calculate MPP domain decomposition 39 !! factorise : calculate the factors of the no. of MPI processes 36 40 !!---------------------------------------------------------------------- 37 41 USE step_oce ! module used in the ocean time stepping module … … 70 74 #endif 71 75 76 IMPLICIT NONE 72 77 PRIVATE 73 78 … … 78 83 79 84 !!---------------------------------------------------------------------- 80 !! NEMO/OPA 3.3 , NEMO Consortium (2010)85 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 81 86 !! $Id$ 82 87 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 95 100 !! - finalize the run by closing files and communications 96 101 !! 97 !! References : Madec, Delecluse, Imbard, and Levy, 1997: internal report, IPSL.102 !! References : Madec, Delecluse, Imbard, and Levy, 1997: internal report, IPSL. 98 103 !! Madec, 2008, internal report, IPSL. 99 104 !!---------------------------------------------------------------------- … … 108 113 CALL nemo_init !== Initialisations ==! 109 114 ! !-----------------------! 110 115 #if defined key_agrif 116 CALL Agrif_Declare_Var ! AGRIF: set the meshes 117 # if defined key_top 118 CALL Agrif_Declare_Var_Top ! AGRIF: set the meshes 119 # endif 120 #endif 111 121 ! check that all process are still there... If some process have an error, 112 122 ! they will never enter in step and other processes will wait until the end of the cpu time! … … 177 187 !! ** Purpose : initialization of the NEMO GCM 178 188 !!---------------------------------------------------------------------- 179 INTEGER :: ji ! dummy loop indices180 INTEGER :: ilocal_comm ! local integer181 CHARACTER(len=80), DIMENSION(1 0) :: cltxt189 INTEGER :: ji ! dummy loop indices 190 INTEGER :: ilocal_comm ! local integer 191 CHARACTER(len=80), DIMENSION(16) :: cltxt 182 192 !! 183 193 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & … … 198 208 IF( Agrif_Root() ) THEN 199 209 # if defined key_oasis3 || defined key_oasis4 200 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis210 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 201 211 # endif 202 CALL init_ioclient( ilocal_comm ) ! exchange io_server nemo local communicator with the io_server203 ENDIF 204 narea = mynode( cltxt, ilocal_comm )! Nodes selection212 CALL init_ioclient( ilocal_comm ) ! exchange io_server nemo local communicator with the io_server 213 ENDIF 214 narea = mynode( cltxt, numnam, nstop, ilocal_comm ) ! Nodes selection 205 215 #else 206 216 # if defined key_oasis3 || defined key_oasis4 207 217 IF( Agrif_Root() ) THEN 208 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis209 ENDIF 210 narea = mynode( cltxt, ilocal_comm )! Nodes selection (control print return in cltxt)218 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 219 ENDIF 220 narea = mynode( cltxt, numnam, nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 211 221 # else 212 222 ilocal_comm = 0 213 narea = mynode( cltxt ) ! Nodes selection (control print return in cltxt)223 narea = mynode( cltxt, numnam, nstop ) ! Nodes selection (control print return in cltxt) 214 224 # endif 215 225 #endif 216 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 217 218 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 226 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 227 228 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 229 230 ! If dimensions of processor grid weren't specified in the namelist file 231 ! then we calculate them here now that we have our communicator size 232 IF( (jpni < 1) .OR. (jpnj < 1) )THEN 233 #if defined key_mpp_mpi 234 IF( Agrif_Root() ) CALL nemo_partition(mppsize) 235 #else 236 jpni = 1 237 jpnj = 1 238 jpnij = jpni*jpnj 239 #endif 240 END IF 241 242 ! Calculate domain dimensions given calculated jpni and jpnj 243 ! This used to be done in par_oce.F90 when they were parameters rather 244 ! than variables 245 IF( Agrif_Root() ) THEN 246 jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 247 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 248 jpk = jpkdta ! third dim 249 jpim1 = jpi-1 ! inner domain indices 250 jpjm1 = jpj-1 ! " " 251 jpkm1 = jpk-1 ! " " 252 jpij = jpi*jpj ! jpi x j 253 ENDIF 219 254 220 255 IF(lwp) THEN ! open listing units … … 235 270 ! 236 271 ENDIF 272 273 ! Now we know the dimensions of the grid and numout has been set we can 274 ! allocate arrays 275 CALL nemo_alloc() 276 237 277 ! !-------------------------------! 238 278 ! ! NEMO general initialization ! … … 427 467 END SUBROUTINE nemo_closefile 428 468 469 470 SUBROUTINE nemo_alloc 471 !!---------------------------------------------------------------------- 472 !! *** ROUTINE nemo_alloc *** 473 !! 474 !! ** Purpose : Allocate all the dynamic arrays of the OPA modules 475 !! 476 !! ** Method : 477 !!---------------------------------------------------------------------- 478 USE diawri , ONLY: dia_wri_alloc 479 USE dom_oce , ONLY: dom_oce_alloc 480 USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc 481 USE ldftra_oce, ONLY: ldftra_oce_alloc 482 USE trc_oce , ONLY: trc_oce_alloc 483 USE wrk_nemo , ONLY: wrk_alloc 484 ! 485 INTEGER :: ierr 486 !!---------------------------------------------------------------------- 487 ! 488 ierr = oce_alloc () ! ocean 489 ierr = ierr + dia_wri_alloc () 490 ierr = ierr + dom_oce_alloc () ! ocean domain 491 ierr = ierr + ldfdyn_oce_alloc() ! ocean lateral physics : dynamics 492 ierr = ierr + ldftra_oce_alloc() ! ocean lateral physics : tracers 493 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 494 ! 495 ierr = ierr + lib_mpp_alloc (numout) ! mpp exchanges 496 ierr = ierr + trc_oce_alloc () ! shared TRC / TRA arrays 497 ! 498 ierr = ierr + wrk_alloc(numout, lwp) ! workspace 499 ! 500 IF( lk_mpp ) CALL mpp_sum( ierr ) 501 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' ) 502 ! 503 END SUBROUTINE nemo_alloc 504 505 506 SUBROUTINE nemo_partition( num_pes ) 507 !!---------------------------------------------------------------------- 508 !! *** ROUTINE nemo_partition *** 509 !! 510 !! ** Purpose : 511 !! 512 !! ** Method : 513 !!---------------------------------------------------------------------- 514 INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 515 ! 516 INTEGER, PARAMETER :: nfactmax = 20 517 INTEGER :: nfact ! The no. of factors returned 518 INTEGER :: ierr ! Error flag 519 INTEGER :: ji 520 INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value 521 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 522 !!---------------------------------------------------------------------- 523 524 ierr = 0 525 526 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 527 528 IF( nfact <= 1 ) THEN 529 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 530 WRITE (numout, *) ' : using grid of ',num_pes,' x 1' 531 jpnj = 1 532 jpni = num_pes 533 ELSE 534 ! Search through factors for the pair that are closest in value 535 mindiff = 1000000 536 imin = 1 537 DO ji = 1, nfact-1, 2 538 idiff = ABS( ifact(ji) - ifact(ji+1) ) 539 IF( idiff < mindiff ) THEN 540 mindiff = idiff 541 imin = ji 542 ENDIF 543 END DO 544 jpnj = ifact(imin) 545 jpni = ifact(imin + 1) 546 ENDIF 547 ! 548 jpnij = jpni*jpnj 549 ! 550 END SUBROUTINE nemo_partition 551 552 553 SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr ) 554 !!---------------------------------------------------------------------- 555 !! *** ROUTINE factorise *** 556 !! 557 !! ** Purpose : return the prime factors of n. 558 !! knfax factors are returned in array kfax which is of 559 !! maximum dimension kmaxfax. 560 !! ** Method : 561 !!---------------------------------------------------------------------- 562 INTEGER , INTENT(in ) :: kn, kmaxfax 563 INTEGER , INTENT( out) :: kerr, knfax 564 INTEGER, DIMENSION(kmaxfax), INTENT( out) :: kfax 565 ! 566 INTEGER :: ifac, jl, inu 567 INTEGER, PARAMETER :: ntest = 14 568 INTEGER :: ilfax(ntest) 569 570 ! lfax contains the set of allowed factors. 571 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & 572 & 128, 64, 32, 16, 8, 4, 2 / 573 !!---------------------------------------------------------------------- 574 575 ! Clear the error flag and initialise output vars 576 kerr = 0 577 kfax = 1 578 knfax = 0 579 580 ! Find the factors of n. 581 IF( kn == 1 ) GOTO 20 582 583 ! nu holds the unfactorised part of the number. 584 ! knfax holds the number of factors found. 585 ! l points to the allowed factor list. 586 ! ifac holds the current factor. 587 588 inu = kn 589 knfax = 0 590 591 DO jl = ntest, 1, -1 592 ! 593 ifac = ilfax(jl) 594 IF( ifac > inu ) CYCLE 595 596 ! Test whether the factor will divide. 597 598 IF( MOD(inu,ifac) == 0 ) THEN 599 ! 600 knfax = knfax + 1 ! Add the factor to the list 601 IF( knfax > kmaxfax ) THEN 602 kerr = 6 603 write (*,*) 'FACTOR: insufficient space in factor array ', knfax 604 return 605 ENDIF 606 kfax(knfax) = ifac 607 ! Store the other factor that goes with this one 608 knfax = knfax + 1 609 kfax(knfax) = inu / ifac 610 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 611 ENDIF 612 ! 613 END DO 614 615 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 616 ! 617 END SUBROUTINE factorise 618 429 619 !!====================================================================== 430 620 END MODULE nemogcm
Note: See TracChangeset
for help on using the changeset viewer.