- 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/SAS_SRC/nemogcm.F90
r9200 r9213 18 18 !! nemo_partition: calculate MPP domain decomposition 19 19 !! factorise : calculate the factors of the no. of MPI processes 20 !! nemo_nfdcom : Setup for north fold exchanges with explicit point-to-point messaging 20 21 !!---------------------------------------------------------------------- 21 22 USE step_oce ! module used in the ocean time stepping module … … 37 38 USE lib_mpp ! distributed memory computing 38 39 USE mppini ! shared/distributed memory setting (mpp_init routine) 39 USE lbcnfd , ONLY: isendto, nsndto, nfsloop, nfeloop! Setup of north fold exchanges40 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 40 41 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 41 42 #if defined key_iomput … … 52 53 53 54 !!---------------------------------------------------------------------- 54 !! NEMO/OPA 4.0 , NEMO Consortium (201 6)55 !! NEMO/OPA 4.0 , NEMO Consortium (2018) 55 56 !! $Id$ 56 57 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 76 77 ! 77 78 #if defined key_agrif 78 CALL Agrif_Init_Grids() ! AGRIF: set the meshes 79 #endif 80 ! 79 CALL Agrif_Init_Grids() ! AGRIF: set the meshes 80 #endif 81 81 ! !-----------------------! 82 82 CALL nemo_init !== Initialisations ==! … … 102 102 ! !-----------------------! 103 103 istp = nit000 104 ! 104 105 #if defined key_agrif 106 ! !== AGRIF time-stepping ==! 105 107 CALL Agrif_Regrid() 106 #endif 107 108 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 109 #if defined key_agrif 110 CALL stp ! AGRIF: time stepping 108 ! 109 DO WHILE( istp <= nitend .AND. nstop == 0 ) 110 CALL stp 111 istp = istp + 1 112 END DO 113 ! 114 IF( .NOT. Agrif_Root() ) THEN 115 CALL Agrif_ParentGrid_To_ChildGrid() 116 IF( ln_timing ) CALL timing_finalize 117 CALL Agrif_ChildGrid_To_ParentGrid() 118 ENDIF 119 ! 111 120 #else 112 IF ( .NOT. ln_diurnal_only ) THEN 113 CALL stp( istp ) ! standard time stepping 114 ELSE 115 CALL stp_diurnal( istp ) ! time step only the diurnal SST 116 ENDIF 117 #endif 118 istp = istp + 1 119 IF( lk_mpp ) CALL mpp_max( nstop ) 121 ! 122 IF( .NOT.ln_diurnal_only ) THEN !== Standard time-stepping ==! 123 ! 124 DO WHILE( istp <= nitend .AND. nstop == 0 ) 125 CALL stp ( istp ) 126 istp = istp + 1 120 127 END DO 128 ! 129 ELSE !== diurnal SST time-steeping only ==! 130 ! 131 DO WHILE( istp <= nitend .AND. nstop == 0 ) 132 CALL stp_diurnal( istp ) ! time step only the diurnal SST 133 istp = istp + 1 134 END DO 135 ! 136 ENDIF 137 ! 138 #endif 121 139 ! 122 140 IF( ln_icebergs ) CALL icb_end( nitend ) … … 129 147 IF( nstop /= 0 .AND. lwp ) THEN ! error print 130 148 WRITE(numout,cform_err) 131 WRITE(numout,*) nstop, ' error have been found' 132 ENDIF 133 ! 134 #if defined key_agrif 135 CALL Agrif_ParentGrid_To_ChildGrid() 136 IF( ln_timing ) CALL timing_finalize 137 CALL Agrif_ChildGrid_To_ParentGrid() 138 #endif 149 WRITE(numout,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 150 WRITE(numout,*) 151 ENDIF 152 ! 139 153 IF( ln_timing ) CALL timing_finalize 140 154 ! … … 142 156 ! 143 157 #if defined key_iomput 144 CALL xios_finalize! end mpp communications with xios145 IF( lk_oasis ) CALL cpl_finalize! end coupling and mpp communications with OASIS158 CALL xios_finalize ! end mpp communications with xios 159 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 146 160 #else 147 IF( lk_oasis ) THEN 148 CALL cpl_finalize ! end coupling and mpp communications with OASIS 149 ELSE 150 IF( lk_mpp ) CALL mppstop ! end mpp communications 161 IF ( lk_oasis ) THEN ; CALL cpl_finalize ! end coupling and mpp communications with OASIS 162 ELSEIF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications 151 163 ENDIF 152 164 #endif … … 161 173 !! ** Purpose : initialization of the NEMO GCM 162 174 !!---------------------------------------------------------------------- 163 INTEGER :: ji ! dummy loop indices 164 INTEGER :: ilocal_comm ! local integer 165 INTEGER :: ios, inum ! - - 166 INTEGER :: iiarea, ijarea ! local integers 167 INTEGER :: iirest, ijrest ! local integers 175 INTEGER :: ji ! dummy loop indices 176 INTEGER :: ios, ilocal_comm ! local integers 177 INTEGER :: iiarea, ijarea ! - - 178 INTEGER :: iirest, ijrest ! - - 168 179 CHARACTER(len=120), DIMENSION(30) :: cltxt, cltxt2, clnam 169 180 CHARACTER(len=80) :: clname 170 ! 181 !! 171 182 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 172 183 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 173 184 & ln_timing, ln_diacfl 174 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_ write_cfg, cn_domcfg_out, ln_use_jattr, ln_closea185 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 175 186 !!---------------------------------------------------------------------- 176 187 ! … … 193 204 ENDIF 194 205 ! 195 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints206 REWIND( numnam_ref ) ! Namelist namctl in reference namelist 196 207 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 197 208 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) … … 200 211 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 201 212 ! 202 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist : Control prints213 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist 203 214 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 204 215 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 205 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist : Control prints & Benchmark216 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist 206 217 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 207 218 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) … … 325 336 IF(lwp) THEN ! open listing units 326 337 ! 327 IF( lk_oasis ) THEN 328 CALL ctl_opn( numout, 'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 329 ELSE 330 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 338 IF( lk_oasis ) THEN ; CALL ctl_opn( numout, 'sas.output', 'REPLACE','FORMATTED','SEQUENTIAL', -1, 6, .FALSE., narea ) 339 ELSE ; CALL ctl_opn( numout, 'ocean.output', 'REPLACE','FORMATTED','SEQUENTIAL', -1, 6, .FALSE., narea ) 331 340 ENDIF 332 341 ! … … 335 344 WRITE(numout,*) ' NEMO team' 336 345 WRITE(numout,*) ' Ocean General Circulation Model' 337 WRITE(numout,*) ' version 3.7 (2016) '346 WRITE(numout,*) ' NEMO version 4.0 (2017) ' 338 347 WRITE(numout,*) ' StandAlone Surface version (SAS) ' 339 348 WRITE(numout,*) … … 354 363 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 355 364 CALL nemo_alloc() 365 356 366 ! !-------------------------------! 357 367 ! ! NEMO general initialization ! … … 361 371 362 372 ! ! Domain decomposition 363 CALL mpp_init 364 ! 365 IF( ln_timing ) CALL timing_init 366 ! 367 ! ! General initialization 368 CALL phy_cst ! Physical constants 369 CALL eos_init ! Equation of state 370 CALL dom_init ! Domain 371 372 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 373 374 IF( ln_ctl ) CALL prt_ctl_init ! Print control 375 CALL day_init ! model calendar (using both namelist and restart infos) 376 IF( ln_rstart ) CALL rst_read_open 377 378 CALL sbc_init ! Forcings : surface module 373 CALL mpp_init ! MPP 374 IF( ln_nnogather ) CALL nemo_nfdcom ! northfold neighbour lists 375 ! 376 ! 377 ! ! General initialization 378 IF( ln_timing ) CALL timing_init ! timing 379 IF( ln_timing ) CALL timing_start( 'nemo_init') 380 381 CALL phy_cst ! Physical constants 382 CALL eos_init ! Equation of seawater 383 CALL dom_init ! Domain 384 IF( ln_ctl ) CALL prt_ctl_init ! Print control 385 386 CALL day_init ! model calendar (using both namelist and restart infos) 387 IF( ln_rstart ) CALL rst_read_open 388 389 ! ! external forcing 390 CALL sbc_init ! Forcings : surface module 379 391 380 392 ! ==> clem: open boundaries init. is mandatory for sea-ice because ice BDY is not decoupled from … … 384 396 ! ==> 385 397 CALL icb_init( rdt, nit000) ! initialise icebergs instance 386 387 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 398 ! 399 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 400 ! 401 IF( ln_timing ) CALL timing_stop( 'nemo_init') 388 402 ! 389 403 END SUBROUTINE nemo_init … … 394 408 !! *** ROUTINE nemo_ctl *** 395 409 !! 396 !! ** Purpose : control print setting 410 !! ** Purpose : control print setting 397 411 !! 398 412 !! ** Method : - print namctl information and check some consistencies … … 402 416 WRITE(numout,*) 403 417 WRITE(numout,*) 'nemo_ctl: Control prints' 404 WRITE(numout,*) '~~~~~~~ 418 WRITE(numout,*) '~~~~~~~~' 405 419 WRITE(numout,*) ' Namelist namctl' 406 420 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl … … 426 440 IF(lwp) THEN ! control print 427 441 WRITE(numout,*) 428 WRITE(numout,*) 'namcfg : configuration initialization through namelist read'429 WRITE(numout,*) '~~~~~~~ '430 442 WRITE(numout,*) ' Namelist namcfg' 431 WRITE(numout,*) ' read domain configuration file sln_read_cfg = ', ln_read_cfg443 WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg 432 444 WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg) 433 WRITE(numout,*) ' write configuration definition files ln_write_cfg = ', ln_write_cfg 445 WRITE(numout,*) ' keep closed seas in the domain (if exist) ln_closea = ', ln_closea 446 WRITE(numout,*) ' create a configuration definition file ln_write_cfg = ', ln_write_cfg 434 447 WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out) 435 448 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 436 449 ENDIF 450 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file 451 ! 437 452 ! ! Parameter control 438 453 ! … … 474 489 ENDIF 475 490 ! 476 IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', & 477 & 'f2003 standard. ' , & 478 & 'Compile with key_nosignedzero enabled' ) 491 IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', & 492 & 'Compile with key_nosignedzero enabled' ) 493 ! 494 #if defined key_agrif 495 IF( ln_timing ) CALL ctl_stop( 'AGRIF not implemented with ln_timing = true') 496 #endif 479 497 ! 480 498 END SUBROUTINE nemo_ctl … … 492 510 CALL iom_close ! close all input/output files managed by iom_* 493 511 ! 494 IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file512 IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file 495 513 IF( numnam_ref /= -1 ) CLOSE( numnam_ref ) ! oce reference namelist 496 514 IF( numnam_cfg /= -1 ) CLOSE( numnam_cfg ) ! oce configuration namelist … … 499 517 IF( numnam_ice_cfg /= -1 ) CLOSE( numnam_ice_cfg ) ! ice configuration namelist 500 518 IF( lwm.AND.numoni /= -1 ) CLOSE( numoni ) ! ice output namelist 501 IF( numevo_ice /= -1 ) CLOSE( numevo_ice ) ! ice variables (temp. evolution)502 IF( numout /= 6 ) CLOSE( numout ) ! standard model output file519 IF( numevo_ice /= -1 ) CLOSE( numevo_ice ) ! ice variables (temp. evolution) 520 IF( numout /= 6 ) CLOSE( numout ) ! standard model output file 503 521 ! 504 522 numout = 6 ! redefine numout in case it is used after this point... … … 515 533 !! ** Method : 516 534 !!---------------------------------------------------------------------- 517 USE diawri , ONLY : dia_wri_alloc518 USE dom_oce , ONLY : dom_oce_alloc519 USE bdy_oce , ONLY : ln_bdy, bdy_oce_alloc535 USE diawri , ONLY : dia_wri_alloc 536 USE dom_oce , ONLY : dom_oce_alloc 537 USE bdy_oce , ONLY : ln_bdy, bdy_oce_alloc 520 538 USE oce ! mandatory for sea-ice because needed for bdy arrays 521 539 ! … … 523 541 !!---------------------------------------------------------------------- 524 542 ! 525 ierr = dia_wri_alloc 526 ierr = ierr + dom_oce_alloc 527 ierr = ierr + oce_alloc 528 ierr = ierr + bdy_oce_alloc 543 ierr = dia_wri_alloc() 544 ierr = ierr + dom_oce_alloc() ! ocean domain 545 ierr = ierr + oce_alloc () ! (tsn...) needed for agrif and/or ESIM and bdy 546 ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization) 529 547 ! 530 548 IF( lk_mpp ) CALL mpp_sum( ierr ) 531 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc 549 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' ) 532 550 ! 533 551 END SUBROUTINE nemo_alloc … … 538 556 !! *** ROUTINE nemo_partition *** 539 557 !! 540 !! ** Purpose : 558 !! ** Purpose : 541 559 !! 542 560 !! ** Method : … … 607 625 knfax = 0 608 626 ! 609 ! Find the factors of n. 610 IF( kn .NE. 1 ) THEN 611 627 IF( kn /= 1 ) THEN ! Find the factors of n 628 ! 612 629 ! nu holds the unfactorised part of the number. 613 630 ! knfax holds the number of factors found. … … 622 639 ifac = ilfax(jl) 623 640 IF( ifac > inu ) CYCLE 624 641 ! 625 642 ! Test whether the factor will divide. 626 643 ! 627 644 IF( MOD(inu,ifac) == 0 ) THEN 628 645 ! … … 648 665 #if defined key_mpp_mpi 649 666 650 SUBROUTINE nemo_n orthcomms651 !!---------------------------------------------------------------------- 652 !! *** ROUTINE nemo_n orthcomms***667 SUBROUTINE nemo_nfdcom 668 !!---------------------------------------------------------------------- 669 !! *** ROUTINE nemo_nfdcom *** 653 670 !! ** Purpose : Setup for north fold exchanges with explicit 654 671 !! point-to-point messaging … … 669 686 nsndto = 0 670 687 ! 671 !if I am a process in the north 672 IF ( njmpp == njmppmax ) THEN 673 !sxM is the first point (in the global domain) needed to compute the 674 !north-fold for the current process 675 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 676 !dxM is the last point (in the global domain) needed to compute the 677 !north-fold for the current process 678 dxM = jpiglo - nimppt(narea) + 2 679 680 !loop over the other north-fold processes to find the processes 681 !managing the points belonging to the sxT-dxT range 682 683 DO jn = 1, jpni 684 !sxT is the first point (in the global domain) of the jn 685 !process 686 sxT = nfiimpp(jn, jpnj) 687 !dxT is the last point (in the global domain) of the jn 688 !process 689 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 690 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 691 nsndto = nsndto + 1 692 isendto(nsndto) = jn 693 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 694 nsndto = nsndto + 1 695 isendto(nsndto) = jn 696 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 697 nsndto = nsndto + 1 698 isendto(nsndto) = jn 699 ENDIF 700 END DO 701 nfsloop = 1 702 nfeloop = nlci 703 DO jn = 2,jpni-1 704 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 705 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 706 nfsloop = nldi 707 ENDIF 708 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 709 nfeloop = nlei 710 ENDIF 711 ENDIF 712 END DO 713 688 IF ( njmpp == njmppmax ) THEN ! if I am a process in the north 689 ! 690 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 691 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 692 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 693 dxM = jpiglo - nimppt(narea) + 2 694 ! 695 ! loop over the other north-fold processes to find the processes 696 ! managing the points belonging to the sxT-dxT range 697 ! 698 DO jn = 1, jpni 699 ! 700 sxT = nfiimpp(jn, jpnj) ! sxT = 1st point (in the global domain) of the jn process 701 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 ! dxT = last point (in the global domain) of the jn process 702 ! 703 IF ( sxT < sxM .AND. sxM < dxT ) THEN 704 nsndto = nsndto + 1 705 isendto(nsndto) = jn 706 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN 707 nsndto = nsndto + 1 708 isendto(nsndto) = jn 709 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN 710 nsndto = nsndto + 1 711 isendto(nsndto) = jn 712 ENDIF 713 ! 714 END DO 715 nfsloop = 1 716 nfeloop = nlci 717 DO jn = 2,jpni-1 718 IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN 719 IF( nfipproc(jn-1,jpnj) == -1 ) nfsloop = nldi 720 IF( nfipproc(jn+1,jpnj) == -1 ) nfeloop = nlei 721 ENDIF 722 END DO 723 ! 714 724 ENDIF 715 725 l_north_nogather = .TRUE. 716 END SUBROUTINE nemo_northcomms 726 ! 727 END SUBROUTINE nemo_nfdcom 717 728 718 729 #else 719 SUBROUTINE nemo_n orthcomms! Dummy routine720 WRITE(*,*) 'nemo_n orthcomms: You should not have seen this print! error?'721 END SUBROUTINE nemo_n orthcomms730 SUBROUTINE nemo_nfdcom ! Dummy routine 731 WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?' 732 END SUBROUTINE nemo_nfdcom 722 733 #endif 723 734 724 735 !!====================================================================== 725 736 END MODULE nemogcm 737
Note: See TracChangeset
for help on using the changeset viewer.
