- Timestamp:
- 2018-01-12T10:38:50+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r9210 r9213 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-10 (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_n orthcomms30 !! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_nfdcom 31 31 !! - ! 2011-11 (C. Harris) decomposition changes for running with CICE 32 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_n orthcomms: setup avoiding MPI communication33 !! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_nfdcom: setup avoiding MPI communication 34 34 !! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla) 35 35 !! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface … … 44 44 !! nemo_partition: calculate MPP domain decomposition 45 45 !! factorise : calculate the factors of the no. of MPI processes 46 !! nemo_nfdcom : Setup for north fold exchanges with explicit point-to-point messaging 46 47 !!---------------------------------------------------------------------- 47 48 USE step_oce ! module used in the ocean time stepping module (step.F90) … … 88 89 USE lib_mpp ! distributed memory computing 89 90 USE mppini ! shared/distributed memory setting (mpp_init routine) 90 USE lbcnfd , ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges91 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 91 92 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 92 93 #if defined key_iomput … … 104 105 105 106 !!---------------------------------------------------------------------- 106 !! NEMO/OPA 3.7 , NEMO Consortium (2016)107 !! NEMO/OPA 4.0 , NEMO Consortium (2018) 107 108 !! $Id$ 108 109 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 130 131 CALL Agrif_Init_Grids() ! AGRIF: set the meshes 131 132 #endif 132 !133 133 ! !-----------------------! 134 134 CALL nemo_init !== Initialisations ==! … … 161 161 END DO 162 162 #else 163 164 !!gm This data assimilation calls should be part of the initialisation (i.e. put in asm_inc_init)165 !166 IF( lk_asminc ) THEN !== data assimilation ==! (done prior to time stepping)167 IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 ) ! Output background fields168 IF( ln_asmdin ) THEN ! Direct initialization169 IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 ) ! Tracers170 IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics171 IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 ) ! SSH172 ENDIF173 ENDIF174 !!gm end175 163 ! 176 164 # if defined key_agrif 177 165 ! !== AGRIF time-stepping ==! 178 166 CALL Agrif_Regrid() 167 ! 179 168 DO WHILE( istp <= nitend .AND. nstop == 0 ) 180 169 CALL stp … … 222 211 IF( nstop /= 0 .AND. lwp ) THEN ! error print 223 212 WRITE(numout,cform_err) 224 WRITE(numout,*) ' nemo_gcm: a total of ', nstop, ' errors have been found'213 WRITE(numout,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 225 214 WRITE(numout,*) 226 215 ENDIF … … 249 238 !!---------------------------------------------------------------------- 250 239 INTEGER :: ji ! dummy loop indices 251 INTEGER :: ios, ilocal_comm ! local integer 252 INTEGER :: iiarea, ijarea ! local integers253 INTEGER :: iirest, ijrest ! local integers240 INTEGER :: ios, ilocal_comm ! local integers 241 INTEGER :: iiarea, ijarea ! - - 242 INTEGER :: iirest, ijrest ! - - 254 243 CHARACTER(len=120), DIMENSION(30) :: cltxt, cltxt2, clnam 255 ! 244 !! 256 245 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 257 246 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 258 247 & ln_timing, ln_diacfl 259 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_ write_cfg, cn_domcfg_out, ln_use_jattr, ln_closea248 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 260 249 !!---------------------------------------------------------------------- 261 250 ! … … 269 258 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 270 259 ! 271 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints260 REWIND( numnam_ref ) ! Namelist namctl in reference namelist 272 261 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 273 262 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) … … 276 265 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 277 266 ! 278 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist : Control prints267 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist 279 268 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 280 269 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 281 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist : Control prints & Benchmark270 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist 282 271 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 283 272 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) … … 435 424 436 425 ! ! Domain decomposition 437 CALL mpp_init 438 IF( ln_nnogather ) CALL nemo_northcomms! northfold neighbour lists 439 ! 440 IF( ln_timing ) CALL timing_init 426 CALL mpp_init ! MPP 427 IF( ln_nnogather ) CALL nemo_nfdcom ! northfold neighbour lists 441 428 ! 442 429 ! ! General initialization 443 CALL phy_cst ! Physical constants 444 CALL eos_init ! Equation of state 445 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 446 CALL wad_init ! Wetting and drying options 447 CALL dom_init ! Domain 448 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization 449 IF( ln_ctl ) CALL prt_ctl_init ! Print control 430 IF( ln_timing ) CALL timing_init ! timing 431 IF( ln_timing ) CALL timing_start( 'nemo_init') 432 ! 433 CALL phy_cst ! Physical constants 434 CALL eos_init ! Equation of state 435 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 436 CALL wad_init ! Wetting and drying options 437 CALL dom_init ! Domain 438 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization 439 IF( ln_ctl ) CALL prt_ctl_init ! Print control 450 440 451 CALL diurnal_sst_bulk_init ! diurnal sst 452 IF ( ln_diurnal ) CALL diurnal_sst_coolskin_init ! cool skin 441 CALL diurnal_sst_bulk_init ! diurnal sst 442 IF( ln_diurnal ) CALL diurnal_sst_coolskin_init ! cool skin 443 ! 444 IF( ln_diurnal_only ) THEN ! diurnal only: a subset of the initialisation routines 445 CALL istate_init ! ocean initial state (Dynamics and tracers) 446 CALL sbc_init ! Forcings : surface module 447 CALL tra_qsr_init ! penetrative solar radiation qsr 448 IF( ln_diaobs ) THEN ! Observation & model comparison 449 CALL dia_obs_init ! Initialize observational data 450 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 451 ENDIF 452 IF( lk_asminc ) CALL asm_inc_init ! Assimilation increments 453 ! 454 RETURN ! end of initialization 455 ENDIF 453 456 454 ! IF ln_diurnal_only, then we only want a subset of the initialisation routines 455 IF( ln_diurnal_only ) THEN 456 CALL istate_init ! ocean initial state (Dynamics and tracers) 457 CALL sbc_init ! Forcings : surface module 458 CALL tra_qsr_init ! penetrative solar radiation qsr 459 IF( ln_diaobs ) THEN ! Observation & model comparison 460 CALL dia_obs_init ! Initialize observational data 461 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 462 ENDIF 463 ! ! Assimilation increments 464 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 465 466 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 467 RETURN 468 ENDIF 469 470 CALL istate_init ! ocean initial state (Dynamics and tracers) 457 CALL istate_init ! ocean initial state (Dynamics and tracers) 471 458 472 459 ! ! external forcing 473 CALL tide_init ! tidal harmonics474 CALL sbc_init ! surface boundary conditions (including sea-ice)475 CALL bdy_init ! Open boundaries initialisation460 CALL tide_init ! tidal harmonics 461 CALL sbc_init ! surface boundary conditions (including sea-ice) 462 CALL bdy_init ! Open boundaries initialisation 476 463 477 464 ! ! Ocean physics … … 520 507 CALL trd_init ! Mixed-layer/Vorticity/Integral constraints trends 521 508 CALL dia_obs_init ! Initialize observational data 522 IF( ln_diaobs ) CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 509 CALL dia_tmb_init ! TMB outputs 510 CALL dia_25h_init ! 25h mean outputs 511 IF( ln_diaobs ) CALL dia_obs( nit000-1 ) ! Observation operator for restart 523 512 524 513 ! ! Assimilation increments 525 514 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 526 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 527 CALL dia_tmb_init ! TMB outputs 528 CALL dia_25h_init ! 25h mean outputs 515 ! 516 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 517 ! 518 IF( ln_timing ) CALL timing_stop( 'nemo_init') 529 519 ! 530 520 END SUBROUTINE nemo_init … … 543 533 WRITE(numout,*) 544 534 WRITE(numout,*) 'nemo_ctl: Control prints' 545 WRITE(numout,*) '~~~~~~~ 535 WRITE(numout,*) '~~~~~~~~' 546 536 WRITE(numout,*) ' Namelist namctl' 547 537 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl … … 563 553 njctle = nn_jctle 564 554 isplt = nn_isplt 565 jsplt = nn_jsplt 555 jsplt = nn_jsplt 566 556 567 557 IF(lwp) THEN ! control print 568 558 WRITE(numout,*) 569 WRITE(numout,*) 'namcfg : configuration initialization through namelist read'570 WRITE(numout,*) '~~~~~~ '571 559 WRITE(numout,*) ' Namelist namcfg' 572 560 WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg 573 561 WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg) 574 WRITE(numout,*) ' write configuration definition file ln_write_cfg = ', ln_write_cfg 562 WRITE(numout,*) ' keep closed seas in the domain (if exist) ln_closea = ', ln_closea 563 WRITE(numout,*) ' create a configuration definition file ln_write_cfg = ', ln_write_cfg 575 564 WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out) 576 565 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 577 566 ENDIF 567 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file 568 ! 578 569 ! ! Parameter control 579 570 ! … … 615 606 ENDIF 616 607 ! 617 IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', & 618 & 'f2003 standard. ' , & 619 & 'Compile with key_nosignedzero enabled' ) 608 IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', & 609 & 'Compile with key_nosignedzero enabled' ) 620 610 ! 621 611 #if defined key_agrif … … 664 654 !! ** Method : 665 655 !!---------------------------------------------------------------------- 666 USE diawri , ONLY: dia_wri_alloc 667 USE dom_oce , ONLY: dom_oce_alloc 668 USE trc_oce , ONLY: trc_oce_alloc 656 USE diawri , ONLY : dia_wri_alloc 657 USE dom_oce , ONLY : dom_oce_alloc 658 USE trc_oce , ONLY : trc_oce_alloc 659 USE bdy_oce , ONLY : bdy_oce_alloc 669 660 #if defined key_diadct 670 USE diadct , ONLY : diadct_alloc661 USE diadct , ONLY : diadct_alloc 671 662 #endif 672 USE bdy_oce , ONLY: bdy_oce_alloc673 663 ! 674 664 INTEGER :: ierr 675 665 !!---------------------------------------------------------------------- 676 666 ! 677 ierr = oce_alloc ()! ocean678 ierr = ierr + dia_wri_alloc 679 ierr = ierr + dom_oce_alloc ()! ocean domain680 ierr = ierr + zdf_oce_alloc ()! ocean vertical physics681 !682 ierr = ierr + trc_oce_alloc () ! shared TRC / TRA arrays667 ierr = oce_alloc () ! ocean 668 ierr = ierr + dia_wri_alloc() 669 ierr = ierr + dom_oce_alloc() ! ocean domain 670 ierr = ierr + zdf_oce_alloc() ! ocean vertical physics 671 ierr = ierr + trc_oce_alloc() ! shared TRC / TRA arrays 672 ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization) 683 673 ! 684 674 #if defined key_diadct 685 ierr = ierr + diadct_alloc ()!675 ierr = ierr + diadct_alloc () ! 686 676 #endif 687 ierr = ierr + bdy_oce_alloc () ! bdy masks (incl. initialization)688 677 ! 689 678 IF( lk_mpp ) CALL mpp_sum( ierr ) 690 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc 679 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' ) 691 680 ! 692 681 END SUBROUTINE nemo_alloc … … 766 755 knfax = 0 767 756 ! 768 ! Find the factors of n. 769 IF( kn .NE. 1 ) THEN 770 757 IF( kn /= 1 ) THEN ! Find the factors of n 758 ! 771 759 ! nu holds the unfactorised part of the number. 772 760 ! knfax holds the number of factors found. … … 781 769 ifac = ilfax(jl) 782 770 IF( ifac > inu ) CYCLE 783 771 ! 784 772 ! Test whether the factor will divide. 785 773 ! 786 774 IF( MOD(inu,ifac) == 0 ) THEN 787 775 ! … … 807 795 #if defined key_mpp_mpi 808 796 809 SUBROUTINE nemo_n orthcomms810 !!---------------------------------------------------------------------- 811 !! *** ROUTINE nemo_n orthcomms***797 SUBROUTINE nemo_nfdcom 798 !!---------------------------------------------------------------------- 799 !! *** ROUTINE nemo_nfdcom *** 812 800 !! ** Purpose : Setup for north fold exchanges with explicit 813 801 !! point-to-point messaging … … 828 816 nsndto = 0 829 817 ! 830 !if I am a process in the north 831 IF ( njmpp == njmppmax ) THEN 832 !sxM is the first point (in the global domain) needed to compute the 833 !north-fold for the current process 834 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 835 !dxM is the last point (in the global domain) needed to compute the 836 !north-fold for the current process 837 dxM = jpiglo - nimppt(narea) + 2 838 839 !loop over the other north-fold processes to find the processes 840 !managing the points belonging to the sxT-dxT range 841 842 DO jn = 1, jpni 843 !sxT is the first point (in the global domain) of the jn 844 !process 845 sxT = nfiimpp(jn, jpnj) 846 !dxT is the last point (in the global domain) of the jn 847 !process 848 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 849 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 850 nsndto = nsndto + 1 851 isendto(nsndto) = jn 852 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 853 nsndto = nsndto + 1 854 isendto(nsndto) = jn 855 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 856 nsndto = nsndto + 1 857 isendto(nsndto) = jn 858 ENDIF 859 END DO 860 nfsloop = 1 861 nfeloop = nlci 862 DO jn = 2,jpni-1 863 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 864 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 865 nfsloop = nldi 866 ENDIF 867 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 868 nfeloop = nlei 869 ENDIF 870 ENDIF 871 END DO 872 818 IF ( njmpp == njmppmax ) THEN ! if I am a process in the north 819 ! 820 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 821 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 822 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 823 dxM = jpiglo - nimppt(narea) + 2 824 ! 825 ! loop over the other north-fold processes to find the processes 826 ! managing the points belonging to the sxT-dxT range 827 ! 828 DO jn = 1, jpni 829 ! 830 sxT = nfiimpp(jn, jpnj) ! sxT = 1st point (in the global domain) of the jn process 831 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 ! dxT = last point (in the global domain) of the jn process 832 ! 833 IF ( sxT < sxM .AND. sxM < dxT ) THEN 834 nsndto = nsndto + 1 835 isendto(nsndto) = jn 836 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN 837 nsndto = nsndto + 1 838 isendto(nsndto) = jn 839 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN 840 nsndto = nsndto + 1 841 isendto(nsndto) = jn 842 ENDIF 843 ! 844 END DO 845 nfsloop = 1 846 nfeloop = nlci 847 DO jn = 2,jpni-1 848 IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN 849 IF( nfipproc(jn-1,jpnj) == -1 ) nfsloop = nldi 850 IF( nfipproc(jn+1,jpnj) == -1 ) nfeloop = nlei 851 ENDIF 852 END DO 853 ! 873 854 ENDIF 874 855 l_north_nogather = .TRUE. 875 END SUBROUTINE nemo_northcomms 856 ! 857 END SUBROUTINE nemo_nfdcom 876 858 877 859 #else 878 SUBROUTINE nemo_n orthcomms! Dummy routine879 WRITE(*,*) 'nemo_n orthcomms: You should not have seen this print! error?'880 END SUBROUTINE nemo_n orthcomms860 SUBROUTINE nemo_nfdcom ! Dummy routine 861 WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?' 862 END SUBROUTINE nemo_nfdcom 881 863 #endif 882 864
Note: See TracChangeset
for help on using the changeset viewer.
