Changeset 9213 for branches/2017
- Timestamp:
- 2018-01-12T10:38:50+01:00 (7 years ago)
- Location:
- branches/2017/dev_merge_2017/NEMOGCM
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg
r9198 r9213 16 16 ! ! (=F) user defined configuration ==>>> see usrdef(_...) modules 17 17 cn_domcfg = "ORCA_R2_zps_domcfg" ! domain configuration filename 18 ! ! (=F) user defined configuration ==>>> see usrdef(_...) modules19 ln_closea = .false. ! T => keep closed seas (defined by closea_mask field) in the domain and apply20 ! !special treatment of freshwater fluxes.21 ! ! F => suppress closed seas (defined by closea_mask field) from the bathymetry22 ! !at runtime.23 ! ! If there is no closea_mask field in the domain_cfg file or we do not use24 ! ! a domain_cfg filethen this logical does nothing.18 ! 19 ln_closea = .false. ! T => keep closed seas (defined by closea_mask field) in the 20 ! ! domain and apply special treatment of freshwater fluxes. 21 ! ! F => suppress closed seas (defined by closea_mask field) 22 ! ! from the bathymetry at runtime. 23 ! ! If closea_mask field doesn't exist in the domain_cfg file 24 ! ! then this logical does nothing. 25 25 / 26 26 !----------------------------------------------------------------------- … … 28 28 !----------------------------------------------------------------------- 29 29 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 30 rn_rdt = 5760. ! time step for the dynamics and tracer 31 rn_atfp = 0.1 ! asselin time filter parameter 30 32 / 31 33 !----------------------------------------------------------------------- … … 299 301 / 300 302 !----------------------------------------------------------------------- 301 &namctl ! Control prints & Benchmark 302 !----------------------------------------------------------------------- 303 &namctl ! Control prints 304 !----------------------------------------------------------------------- 305 ln_ctl = .false. ! trends control print (expensive!) 306 nn_print = 0 ! level of print (0 no extra print) 307 ln_timing = .false. ! timing by routine write out in timing.output file 308 ln_diacfl = .false. ! CFL diagnostics write out in cfl_diagnostics.ascii 303 309 / 304 310 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/SHARED/namelist_ref
r9198 r9213 74 74 ln_read_cfg = .false. ! (=T) read the domain configuration file 75 75 ! ! (=F) user defined configuration ==>>> see usrdef(_...) modules 76 cn_domcfg = "domain_cfg" 76 cn_domcfg = "domain_cfg" ! domain configuration filename 77 77 ! 78 ln_closea = .false. ! T => keep closed seas (defined by closea_mask field) in the 79 ! ! domain and apply special treatment of freshwater fluxes. 80 ! ! F => suppress closed seas (defined by closea_mask field) 81 ! ! from the bathymetry at runtime. 82 ! ! If closea_mask field doesn't exist in the domain_cfg file 83 ! ! then this logical does nothing. 78 84 ln_write_cfg= .false. ! (=T) create the domain configuration file 79 85 cn_domcfg_out = "domain_cfg_out" ! newly created domain configuration filename … … 81 87 ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present 82 88 ! ! in netcdf input files, as the start j-row for reading 83 ln_closea = .true. ! T => keep closed seas (defined by closea_mask field) in the domain and apply84 ! ! special treatment of freshwater fluxes.85 ! ! F => suppress closed seas (defined by closea_mask field) from the bathymetry86 ! ! at runtime.87 ! ! If there is no closea_mask field in the domain_cfg file or we do not use88 ! ! a domain_cfg file then this logical does nothing.89 89 / 90 90 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
r9169 r9213 10 10 11 11 !!---------------------------------------------------------------------- 12 !! nemo_gcm : off-line: solve ocean tracer only 13 !! nemo_init : initialization of the nemo model 14 !! nemo_ctl : initialisation of algorithm flag 15 !! nemo_closefile : close remaining files 12 !! nemo_gcm : off-line: solve ocean tracer only 13 !! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 14 !! nemo_init : initialization of the NEMO system 15 !! nemo_ctl : initialisation of the contol print 16 !! nemo_closefile: close remaining open files 17 !! nemo_alloc : dynamical allocation 18 !! nemo_partition: calculate MPP domain decomposition 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 21 !! istate_init : simple initialization to zero of ocean fields 22 !! stp_ctl : reduced step control (no dynamics in off-line) 16 23 !!---------------------------------------------------------------------- 17 USE dom_oce ! ocean space domain variables 18 USE oce ! dynamics and tracers variables 19 USE trc_oce ! Shared ocean/passive tracers variables 20 USE c1d ! 1D configuration 21 USE domain ! domain initialization from coordinate & bathymetry (dom_init routine) 22 USE usrdef_nam ! user defined configuration 23 USE eosbn2 ! equation of state (eos bn2 routine) 24 USE dom_oce ! ocean space domain variables 25 USE oce ! dynamics and tracers variables 26 USE trc_oce ! Shared ocean/passive tracers variables 27 USE c1d ! 1D configuration 28 USE domain ! domain initialization from coordinate & bathymetry (dom_init routine) 29 USE closea ! treatment of closed seas (for ln_closea) 30 USE usrdef_nam ! user defined configuration 31 USE eosbn2 ! equation of state (eos bn2 routine) 24 32 ! ! ocean physics 25 USE ldftra 26 USE ldfslp 27 USE traqsr 28 USE trabbl 29 USE traldf 30 USE sbcmod 31 USE phycst 32 USE dtadyn 33 USE trcini 34 USE daymod 35 USE trcstp 36 USE dtadyn 33 USE ldftra ! lateral diffusivity setting (ldf_tra_init routine) 34 USE ldfslp ! slopes of neutral surfaces (ldf_slp_init routine) 35 USE traqsr ! solar radiation penetration (tra_qsr_init routine) 36 USE trabbl ! bottom boundary layer (tra_bbl_init routine) 37 USE traldf ! lateral physics (tra_ldf_init routine) 38 USE sbcmod ! surface boundary condition (sbc_init routine) 39 USE phycst ! physical constant (par_cst routine) 40 USE dtadyn ! Lecture and Interpolation of the dynamical fields 41 USE trcini ! Initilization of the passive tracers 42 USE daymod ! calendar (day routine) 43 USE trcstp ! passive tracer time-stepping (trc_stp routine) 44 USE dtadyn ! Lecture and interpolation of the dynamical fields 37 45 ! ! Passive tracers needs 38 USE trc 39 USE trcnam 40 USE trcrst 41 USE diaptr 42 USE sbc_oce 43 USE sbcrnf 46 USE trc ! passive tracer : variables 47 USE trcnam ! passive tracer : namelist 48 USE trcrst ! passive tracer restart 49 USE diaptr ! Need to initialise this as some variables are used in if statements later 50 USE sbc_oce , ONLY : ln_rnf 51 USE sbcrnf ! surface boundary condition : runoffs 44 52 ! ! I/O & MPP 45 USE iom 46 USE in_out_manager 47 USE mppini 48 USE lib_mpp 53 USE iom ! I/O library 54 USE in_out_manager ! I/O manager 55 USE mppini ! shared/distributed memory setting (mpp_init routine) 56 USE lib_mpp ! distributed memory computing 49 57 #if defined key_iomput 50 USE xios 58 USE xios ! xIOserver 51 59 #endif 52 USE prtctl ! Print control (prt_ctl_init routine) 53 USE timing ! Timing 54 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 55 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 56 57 60 USE prtctl ! Print control (prt_ctl_init routine) 61 USE timing ! Timing 62 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 63 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 58 64 59 65 IMPLICIT NONE … … 65 71 66 72 !!---------------------------------------------------------------------- 67 !! NEMO/OFF 3.3 , NEMO Consortium (2010)73 !! NEMO/OFF 4.0 , NEMO Consortium (2018) 68 74 !! $Id$ 69 75 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 75 81 !! *** ROUTINE nemo_gcm *** 76 82 !! 77 !! ** Purpose : nemosolves the primitive equations on an orthogonal78 !! curvilinear mesh on the sphere.83 !! ** Purpose : NEMO solves the primitive equations on an orthogonal 84 !! curvilinear mesh on the sphere. 79 85 !! 80 86 !! ** Method : - model general initialization … … 99 105 istp = nit000 100 106 ! 101 ! Initialize arrays of runoffs structures and read data from the namelist 102 IF ( ln_rnf ) CALL sbc_rnf(istp) 107 IF( ln_rnf ) CALL sbc_rnf(istp) ! runoffs initialization 103 108 ! 104 CALL iom_init( cxios_context ) 109 CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 105 110 ! 106 DO WHILE ( istp <= nitend .AND. nstop == 0 ) ! time stepping111 DO WHILE ( istp <= nitend .AND. nstop == 0 ) !== OFF time-stepping ==! 107 112 ! 108 113 IF( istp /= nit000 ) CALL day ( istp ) ! Calendar (day was already called at nit000 in day_init) … … 114 119 CALL stp_ctl ( istp, indic ) ! Time loop: control and print 115 120 istp = istp + 1 116 IF( lk_mpp ) CALL mpp_max( nstop )117 121 END DO 122 ! 118 123 #if defined key_iomput 119 124 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF … … 127 132 IF( nstop /= 0 .AND. lwp ) THEN ! error print 128 133 WRITE(numout,cform_err) 129 WRITE(numout,*) nstop, ' error have been found' 134 WRITE(numout,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 135 WRITE(numout,*) 130 136 ENDIF 131 137 ! … … 134 140 CALL nemo_closefile 135 141 ! 136 # 137 CALL xios_finalize ! end mpp communications138 # 139 IF( lk_mpp ) CALL mppstop ! end mpp communications140 # 142 #if defined key_iomput 143 CALL xios_finalize ! end mpp communications with xios 144 #else 145 IF( lk_mpp ) CALL mppstop ! end mpp communications 146 #endif 141 147 ! 142 148 END SUBROUTINE nemo_gcm … … 145 151 SUBROUTINE nemo_init 146 152 !!---------------------------------------------------------------------- 147 !! *** ROUTINE nemo_init ***153 !! *** ROUTINE nemo_init *** 148 154 !! 149 155 !! ** Purpose : initialization of the nemo model in off-line mode 150 156 !!---------------------------------------------------------------------- 151 157 INTEGER :: ji ! dummy loop indices 152 INTEGER :: ilocal_comm ! local integer 153 INTEGER :: ios, inum ! local integers 154 INTEGER :: iiarea, ijarea ! local integers 155 INTEGER :: iirest, ijrest ! local integers 156 REAL(wp) :: ziglo, zjglo, zkglo, zperio ! local scalars 158 INTEGER :: ios, ilocal_comm ! local integers 159 INTEGER :: iiarea, ijarea ! - - 160 INTEGER :: iirest, ijrest ! - - 157 161 CHARACTER(len=120), DIMENSION(30) :: cltxt, cltxt2, clnam 158 162 !! 159 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, &160 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, &163 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 164 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 161 165 & ln_timing, ln_diacfl 162 163 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr164 ! !----------------------------------------------------------------------166 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 167 !!---------------------------------------------------------------------- 168 ! 165 169 cltxt = '' 166 170 cltxt2 = '' … … 172 176 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 173 177 ! 174 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints & Benchmark178 REWIND( numnam_ref ) ! Namelist namctl in reference namelist 175 179 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 176 180 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 177 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist : Control prints & Benchmark181 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist 178 182 READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 179 183 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 180 181 ! 182 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist : Control prints & Benchmark 184 ! 185 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist 183 186 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 184 187 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 185 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist : Control prints & Benchmark188 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist 186 189 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 187 190 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 188 191 189 190 192 ! !--------------------------! 191 193 ! ! Set global domain size ! (control print return in cltxt2) 192 ! 194 ! !--------------------------! 193 195 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 194 196 CALL domain_cfg ( cltxt2, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) … … 198 200 ENDIF 199 201 ! 200 ! 201 l_offline = .true. ! passive tracers are run offline 202 l_offline = .true. ! passive tracers are run offline 202 203 ! 203 204 ! !--------------------------------------------! … … 219 220 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 220 221 221 IF(lwm) THEN 222 ! write merged namelists from earlier to output namelist now that the 223 ! file has been opened in call to mynode. nammpp has already been 224 ! written in mynode (if lk_mpp_mpi) 222 IF(lwm) THEN ! write merged namelists from earlier to output namelist 223 ! ! now that the file has been opened in call to mynode. 224 ! ! NB: nammpp has already been written in mynode (if lk_mpp_mpi) 225 225 WRITE( numond, namctl ) 226 226 WRITE( numond, namcfg ) 227 227 IF( .NOT.ln_read_cfg ) THEN 228 228 DO ji = 1, SIZE(clnam) 229 IF( TRIM(clnam (ji)) /= '' ) WRITE(numond, * ) clnam(ji)! namusr_def print229 IF( TRIM(clnam(ji)) /= '' ) WRITE(numond, * ) clnam(ji) ! namusr_def print 230 230 END DO 231 231 ENDIF … … 234 234 ! If dimensions of processor grid weren't specified in the namelist file 235 235 ! then we calculate them here now that we have our communicator size 236 IF( (jpni < 1) .OR. (jpnj < 1) )THEN236 IF( jpni < 1 .OR. jpnj < 1 ) THEN 237 237 #if defined key_mpp_mpi 238 CALL nemo_partition( mppsize)238 CALL nemo_partition( mppsize ) 239 239 #else 240 jpni = 1241 jpnj = 1240 jpni = 1 241 jpnj = 1 242 242 jpnij = jpni*jpnj 243 243 #endif 244 END 244 ENDIF 245 245 246 246 iiarea = 1 + MOD( narea - 1 , jpni ) … … 279 279 WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC' 280 280 WRITE(numout,*) ' NEMO team' 281 WRITE(numout,*) ' Ocean General CirculationModel'282 WRITE(numout,*) ' version 3.6 (2015) '283 WRITE(numout,*) 284 WRITE(numout,*) 285 DO ji = 1, SIZE(cltxt) 286 IF( TRIM(cltxt (ji)) /= '' ) WRITE(numout,*) cltxt(ji)! control print of mynode281 WRITE(numout,*) ' Off-line TOP Model' 282 WRITE(numout,*) ' NEMO version 4.0 (2017) ' 283 WRITE(numout,*) 284 WRITE(numout,*) 285 DO ji = 1, SIZE(cltxt) 286 IF( TRIM(cltxt (ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode 287 287 END DO 288 WRITE(numout,cform_aaa) ! Flag AAAAAAA 289 ! 290 ENDIF 291 292 ! Now we know the dimensions of the grid and numout has been set we can 293 ! allocate arrays 288 WRITE(numout,*) 289 WRITE(numout,*) 290 DO ji = 1, SIZE(cltxt2) 291 IF( TRIM(cltxt2(ji)) /= '' ) WRITE(numout,*) cltxt2(ji) ! control print of domain size 292 END DO 293 ! 294 WRITE(numout,cform_aaa) ! Flag AAAAAAA 295 ! 296 ENDIF 297 298 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 294 299 CALL nemo_alloc() 295 300 296 ! !------------------------------- -!297 ! ! Modelgeneral initialization !298 ! !------------------------------- -!299 300 CALL nemo_ctl ! Control prints & Benchmark301 ! !-------------------------------! 302 ! ! NEMO general initialization ! 303 ! !-------------------------------! 304 305 CALL nemo_ctl ! Control prints 301 306 302 307 ! ! Domain decomposition 303 CALL mpp_init 304 ! 308 CALL mpp_init ! MPP 309 IF( ln_nnogather ) CALL nemo_nfdcom ! northfold neighbour lists 310 ! 311 ! ! General initialization 305 312 IF( ln_timing ) CALL timing_init 306 !307 308 ! ! General initialization309 313 IF( ln_timing ) CALL timing_start( 'nemo_init') 310 314 ! 311 CALL phy_cst ! Physical constants 312 CALL eos_init ! Equation of state 313 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 314 315 CALL dom_init ! Domain 316 317 CALL istate_init ! ocean initial state (Dynamics and tracers) 318 319 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 320 321 IF( ln_ctl ) CALL prt_ctl_init ! Print control 322 323 CALL sbc_init ! Forcings : surface module 324 325 CALL ldf_tra_init ! Lateral ocean tracer physics 326 CALL ldf_eiv_init ! Eddy induced velocity param 327 CALL tra_ldf_init ! lateral mixing 328 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 329 330 CALL tra_qsr_init ! penetrative solar radiation qsr 331 IF( ln_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 332 315 CALL phy_cst ! Physical constants 316 CALL eos_init ! Equation of state 317 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 318 CALL dom_init ! Domain 319 IF( ln_ctl ) CALL prt_ctl_init ! Print control 320 321 CALL istate_init ! ocean initial state (Dynamics and tracers) 322 323 CALL sbc_init ! Forcings : surface module 324 325 ! ! Tracer physics 326 CALL ldf_tra_init ! Lateral ocean tracer physics 327 CALL ldf_eiv_init ! Eddy induced velocity param 328 CALL tra_ldf_init ! lateral mixing 329 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 330 CALL tra_qsr_init ! penetrative solar radiation qsr 331 IF( ln_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 332 333 ! ! Passive tracers 333 334 CALL trc_nam_run ! Needed to get restart parameters for passive tracers 334 335 CALL trc_rst_cal( nit000, 'READ' ) ! calendar … … 336 337 337 338 CALL trc_init ! Passive tracers initialization 338 CALL dia_ptr_init ! Initialise diaptr as some variables are used339 ! ! in various advection and diffusion routines339 CALL dia_ptr_init ! Poleward TRansports initialization 340 340 341 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 341 342 ! … … 357 358 WRITE(numout,*) 358 359 WRITE(numout,*) 'nemo_ctl: Control prints' 359 WRITE(numout,*) '~~~~~~~ 360 WRITE(numout,*) '~~~~~~~~' 360 361 WRITE(numout,*) ' Namelist namctl' 361 362 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl … … 381 382 IF(lwp) THEN ! control print 382 383 WRITE(numout,*) 383 WRITE(numout,*) 'namcfg : configuration initialization through namelist read'384 WRITE(numout,*) '~~~~~~~ '385 384 WRITE(numout,*) ' Namelist namcfg' 386 WRITE(numout,*) ' read domain configuration file sln_read_cfg = ', ln_read_cfg385 WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg 387 386 WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg) 388 WRITE(numout,*) ' write configuration definition files ln_write_cfg = ', ln_write_cfg 387 WRITE(numout,*) ' keep closed seas in the domain (if exist) ln_closea = ', TRIM(cn_domcfg) 388 WRITE(numout,*) ' create a configuration definition file ln_write_cfg = ', ln_write_cfg 389 389 WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out) 390 390 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 391 391 ENDIF 392 392 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file 393 ! 393 394 ! ! Parameter control 394 395 ! … … 430 431 ENDIF 431 432 ! 432 IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', & 433 & 'f2003 standard. ' , & 434 & 'Compile with key_nosignedzero enabled' ) 433 IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', & 434 & 'Compile with key_nosignedzero enabled' ) 435 435 ! 436 436 END SUBROUTINE nemo_ctl … … 444 444 !!---------------------------------------------------------------------- 445 445 ! 446 IF ( lk_mpp )CALL mppsync446 IF( lk_mpp ) CALL mppsync 447 447 ! 448 448 CALL iom_close ! close all input/output files managed by iom_* … … 453 453 IF( numout /= 6 ) CLOSE( numout ) ! standard model output file 454 454 IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist 455 455 ! 456 456 numout = 6 ! redefine numout in case it is used after this point... 457 457 ! … … 467 467 !! ** Method : 468 468 !!---------------------------------------------------------------------- 469 USE diawri , ONLY: dia_wri_alloc470 USE dom_oce, ONLY: dom_oce_alloc471 USE zdf_oce, ONLY: zdf_oce_alloc472 USE trc_oce, ONLY: trc_oce_alloc469 USE diawri , ONLY : dia_wri_alloc 470 USE dom_oce, ONLY : dom_oce_alloc 471 USE zdf_oce, ONLY : zdf_oce_alloc 472 USE trc_oce, ONLY : trc_oce_alloc 473 473 ! 474 474 INTEGER :: ierr 475 475 !!---------------------------------------------------------------------- 476 476 ! 477 ierr = oce_alloc () ! ocean 478 ierr = ierr + dia_wri_alloc () 479 ierr = ierr + dom_oce_alloc () ! ocean domain 480 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 481 ! 482 ierr = ierr + trc_oce_alloc () ! shared TRC / TRA arrays 477 ierr = oce_alloc () ! ocean 478 ierr = ierr + dia_wri_alloc() 479 ierr = ierr + dom_oce_alloc() ! ocean domain 480 ierr = ierr + zdf_oce_alloc() ! ocean vertical physics 481 ierr = ierr + trc_oce_alloc() ! shared TRC / TRA arrays 483 482 ! 484 483 IF( lk_mpp ) CALL mpp_sum( ierr ) … … 496 495 !! ** Method : 497 496 !!---------------------------------------------------------------------- 498 INTEGER, INTENT(in) :: num_pes! The number of MPI processes we have497 INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 499 498 ! 500 499 INTEGER, PARAMETER :: nfactmax = 20 … … 505 504 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 506 505 !!---------------------------------------------------------------------- 507 506 ! 508 507 ierr = 0 509 508 ! 510 509 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 511 510 ! 512 511 IF( nfact <= 1 ) THEN 513 512 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' … … 540 539 !! 541 540 !! ** Purpose : return the prime factors of n. 542 !! knfax factors are returned in array kfax which is of 541 !! knfax factors are returned in array kfax which is of 543 542 !! maximum dimension kmaxfax. 544 543 !! ** Method : … … 550 549 INTEGER :: ifac, jl, inu 551 550 INTEGER, PARAMETER :: ntest = 14 552 INTEGER :: ilfax(ntest) 551 INTEGER, DIMENSION(ntest) :: ilfax 552 !!---------------------------------------------------------------------- 553 553 ! 554 554 ! lfax contains the set of allowed factors. 555 555 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 556 556 ! 557 557 ! Clear the error flag and initialise output vars 558 kerr = 0559 kfax = 1558 kerr = 0 559 kfax = 1 560 560 knfax = 0 561 562 ! Find the factors of n. 563 IF( kn .NE. 1 ) THEN 564 561 ! 562 IF( kn /= 1 ) THEN ! Find the factors of n 563 ! 565 564 ! nu holds the unfactorised part of the number. 566 565 ! knfax holds the number of factors found. 567 566 ! l points to the allowed factor list. 568 567 ! ifac holds the current factor. 569 568 ! 570 569 inu = kn 571 570 knfax = 0 572 571 ! 573 572 DO jl = ntest, 1, -1 574 573 ! 575 574 ifac = ilfax(jl) 576 575 IF( ifac > inu ) CYCLE 577 576 ! 578 577 ! Test whether the factor will divide. 579 578 ! 580 579 IF( MOD(inu,ifac) == 0 ) THEN 581 580 ! … … 594 593 ! 595 594 END DO 596 595 ! 597 596 ENDIF 598 597 ! … … 600 599 601 600 #if defined key_mpp_mpi 602 SUBROUTINE nemo_northcomms 603 !!====================================================================== 604 !! *** ROUTINE nemo_northcomms *** 605 !! nemo_northcomms : Setup for north fold exchanges with explicit 606 !! point-to-point messaging 607 !!===================================================================== 608 !!---------------------------------------------------------------------- 609 !! 610 !! ** Purpose : Initialization of the northern neighbours lists. 601 602 SUBROUTINE nemo_nfdcom 603 !!---------------------------------------------------------------------- 604 !! *** ROUTINE nemo_nfdcom *** 605 !! ** Purpose : Setup for north fold exchanges with explicit 606 !! point-to-point messaging 607 !! 608 !! ** Method : Initialization of the northern neighbours lists. 611 609 !!---------------------------------------------------------------------- 612 610 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 613 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. 614 !Mocavero, CMCC) 615 !!---------------------------------------------------------------------- 616 611 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 612 !!---------------------------------------------------------------------- 617 613 INTEGER :: sxM, dxM, sxT, dxT, jn 618 614 INTEGER :: njmppmax 619 615 !!---------------------------------------------------------------------- 616 ! 620 617 njmppmax = MAXVAL( njmppt ) 621 618 ! 622 619 !initializes the north-fold communication variables 623 620 isendto(:) = 0 624 nsndto = 0 625 626 !if I am a process in the north 627 IF ( njmpp == njmppmax ) THEN 628 !sxM is the first point (in the global domain) needed to compute the 629 !north-fold for the current process 630 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 631 !dxM is the last point (in the global domain) needed to compute the 632 !north-fold for the current process 633 dxM = jpiglo - nimppt(narea) + 2 634 635 !loop over the other north-fold processes to find the processes 636 !managing the points belonging to the sxT-dxT range 637 638 DO jn = 1, jpni 639 !sxT is the first point (in the global domain) of the jn 640 !process 641 sxT = nfiimpp(jn, jpnj) 642 !dxT is the last point (in the global domain) of the jn 643 !process 644 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 645 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 646 nsndto = nsndto + 1 647 isendto(nsndto) = jn 648 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 649 nsndto = nsndto + 1 650 isendto(nsndto) = jn 651 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 652 nsndto = nsndto + 1 653 isendto(nsndto) = jn 654 END IF 655 END DO 656 nfsloop = 1 657 nfeloop = nlci 658 DO jn = 2,jpni-1 659 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 660 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 661 nfsloop = nldi 662 ENDIF 663 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 664 nfeloop = nlei 665 ENDIF 666 ENDIF 667 END DO 668 621 nsndto = 0 622 ! 623 IF ( njmpp == njmppmax ) THEN ! if I am a process in the north 624 ! 625 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 626 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 627 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 628 dxM = jpiglo - nimppt(narea) + 2 629 ! 630 ! loop over the other north-fold processes to find the processes 631 ! managing the points belonging to the sxT-dxT range 632 ! 633 DO jn = 1, jpni 634 ! 635 sxT = nfiimpp(jn, jpnj) ! sxT = 1st point (in the global domain) of the jn process 636 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 ! dxT = last point (in the global domain) of the jn process 637 ! 638 IF ( sxT < sxM .AND. sxM < dxT ) THEN 639 nsndto = nsndto + 1 640 isendto(nsndto) = jn 641 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN 642 nsndto = nsndto + 1 643 isendto(nsndto) = jn 644 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN 645 nsndto = nsndto + 1 646 isendto(nsndto) = jn 647 ENDIF 648 ! 649 END DO 650 nfsloop = 1 651 nfeloop = nlci 652 DO jn = 2,jpni-1 653 IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN 654 IF( nfipproc(jn-1,jpnj) == -1 ) nfsloop = nldi 655 IF( nfipproc(jn+1,jpnj) == -1 ) nfeloop = nlei 656 ENDIF 657 END DO 658 ! 669 659 ENDIF 670 660 l_north_nogather = .TRUE. 671 END SUBROUTINE nemo_northcomms 661 ! 662 END SUBROUTINE nemo_nfdcom 663 672 664 #else 673 SUBROUTINE nemo_n orthcomms! Dummy routine674 WRITE(*,*) 'nemo_n orthcomms: You should not have seen this print! error?'675 END SUBROUTINE nemo_n orthcomms665 SUBROUTINE nemo_nfdcom ! Dummy routine 666 WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?' 667 END SUBROUTINE nemo_nfdcom 676 668 #endif 677 669 … … 696 688 END SUBROUTINE istate_init 697 689 690 698 691 SUBROUTINE stp_ctl( kt, kindic ) 699 692 !!---------------------------------------------------------------------- … … 722 715 ! 723 716 END SUBROUTINE stp_ctl 717 724 718 !!====================================================================== 725 719 END MODULE nemogcm -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r9168 r9213 74 74 REAL(wp), PUBLIC, DIMENSION(:) , ALLOCATABLE :: wgtiau !: IAU weights for each time step 75 75 #if defined key_asminc 76 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: ssh_iau!: IAU-weighted sea surface height increment76 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: ssh_iau !: IAU-weighted sea surface height increment 77 77 #endif 78 78 ! !!! time steps relative to the cycle interval [0,nitend-nit000-1] … … 254 254 !-------------------------------------------------------------------- 255 255 256 IF 257 256 IF( ln_asmiau ) THEN 257 ! 258 258 ALLOCATE( wgtiau( icycper ) ) 259 259 ! 260 260 wgtiau(:) = 0._wp 261 262 IF ( niaufn == 0 ) THEN 263 264 !--------------------------------------------------------- 265 ! Constant IAU forcing 266 !--------------------------------------------------------- 267 261 ! 262 ! !--------------------------------------------------------- 263 IF( niaufn == 0 ) THEN ! Constant IAU forcing 264 ! !--------------------------------------------------------- 268 265 DO jt = 1, iiauper 269 266 wgtiau(jt+nitiaustr-1) = 1.0 / REAL( iiauper ) 270 267 END DO 271 272 ELSEIF ( niaufn == 1 ) THEN 273 274 !--------------------------------------------------------- 275 ! Linear hat-like, centred in middle of IAU interval 276 !--------------------------------------------------------- 277 268 ! !--------------------------------------------------------- 269 ELSEIF ( niaufn == 1 ) THEN ! Linear hat-like, centred in middle of IAU interval 270 ! !--------------------------------------------------------- 278 271 ! Compute the normalization factor 279 znorm = 0. 0280 IF ( MOD( iiauper, 2 ) == 0 ) THEN! Even number of time steps in IAU interval272 znorm = 0._wp 273 IF( MOD( iiauper, 2 ) == 0 ) THEN ! Even number of time steps in IAU interval 281 274 imid = iiauper / 2 282 275 DO jt = 1, imid … … 284 277 END DO 285 278 znorm = 2.0 * znorm 286 ELSE ! Odd number of time steps in IAU interval279 ELSE ! Odd number of time steps in IAU interval 287 280 imid = ( iiauper + 1 ) / 2 288 281 DO jt = 1, imid - 1 … … 292 285 ENDIF 293 286 znorm = 1.0 / znorm 294 287 ! 295 288 DO jt = 1, imid - 1 296 289 wgtiau(jt+nitiaustr-1) = REAL( jt ) * znorm … … 299 292 wgtiau(jt+nitiaustr-1) = REAL( iiauper - jt + 1 ) * znorm 300 293 END DO 301 294 ! 302 295 ENDIF 303 296 … … 325 318 !-------------------------------------------------------------------- 326 319 327 ALLOCATE( t_bkginc(jpi,jpj,jpk) ) 328 ALLOCATE( s_bkginc(jpi,jpj,jpk) ) 329 ALLOCATE( u_bkginc(jpi,jpj,jpk) ) 330 ALLOCATE( v_bkginc(jpi,jpj,jpk) ) 331 ALLOCATE( ssh_bkginc(jpi,jpj) ) 332 ALLOCATE( seaice_bkginc(jpi,jpj)) 333 t_bkginc (:,:,:) = 0._wp 334 s_bkginc (:,:,:) = 0._wp 335 u_bkginc (:,:,:) = 0._wp 336 v_bkginc (:,:,:) = 0._wp 337 ssh_bkginc (:,:) = 0._wp 338 seaice_bkginc(:,:) = 0._wp 320 ALLOCATE( t_bkginc (jpi,jpj,jpk) ) ; t_bkginc (:,:,:) = 0._wp 321 ALLOCATE( s_bkginc (jpi,jpj,jpk) ) ; s_bkginc (:,:,:) = 0._wp 322 ALLOCATE( u_bkginc (jpi,jpj,jpk) ) ; u_bkginc (:,:,:) = 0._wp 323 ALLOCATE( v_bkginc (jpi,jpj,jpk) ) ; v_bkginc (:,:,:) = 0._wp 324 ALLOCATE( ssh_bkginc (jpi,jpj) ) ; ssh_bkginc (:,:) = 0._wp 325 ALLOCATE( seaice_bkginc(jpi,jpj) ) ; seaice_bkginc(:,:) = 0._wp 339 326 #if defined key_asminc 340 ALLOCATE( ssh_iau(jpi,jpj) ) 341 ssh_iau (:,:) = 0._wp 327 ALLOCATE( ssh_iau (jpi,jpj) ) ; ssh_iau (:,:) = 0._wp 342 328 #endif 343 329 #if defined key_cice && defined key_asminc 344 ALLOCATE( ndaice_da(jpi,jpj) ) 345 ndaice_da (:,:) = 0._wp 346 #endif 347 IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ) ) THEN 348 349 !-------------------------------------------------------------------- 350 ! Read the increments from file 351 !-------------------------------------------------------------------- 352 330 ALLOCATE( ndaice_da (jpi,jpj) ) ; ndaice_da (:,:) = 0._wp 331 #endif 332 ! 333 IF ( ln_trainc .OR. ln_dyninc .OR. & !-------------------------------------- 334 & ln_sshinc .OR. ln_seaiceinc ) THEN ! Read the increments from file 335 ! !-------------------------------------- 353 336 CALL iom_open( c_asminc, inum ) 354 355 CALL iom_get( inum, 'time', zdate_inc ) 356 337 ! 338 CALL iom_get( inum, 'time' , zdate_inc ) 357 339 CALL iom_get( inum, 'z_inc_dateb', z_inc_dateb ) 358 340 CALL iom_get( inum, 'z_inc_datef', z_inc_datef ) 359 341 z_inc_dateb = zdate_inc 360 342 z_inc_datef = zdate_inc 361 343 ! 362 344 IF(lwp) THEN 363 345 WRITE(numout,*) 364 WRITE(numout,*) 'asm_inc_init : Assimilation increments valid ', & 365 & ' between dates ', z_inc_dateb,' and ', & 366 & z_inc_datef 346 WRITE(numout,*) 'asm_inc_init : Assimilation increments valid between dates ', z_inc_dateb,' and ', z_inc_datef 367 347 WRITE(numout,*) '~~~~~~~~~~~~' 368 348 ENDIF 369 370 IF ( ( z_inc_dateb < ndastp + nn_time0*0.0001_wp )&371 & .OR.( z_inc_datef > ditend_date ) ) &372 & CALL ctl_warn( ' Validity time of assimilation increments is ', &373 & ' outside the assimilation interval' )349 ! 350 IF ( ( z_inc_dateb < ndastp + nn_time0*0.0001_wp ) .OR. & 351 & ( z_inc_datef > ditend_date ) ) & 352 & CALL ctl_warn( ' Validity time of assimilation increments is ', & 353 & ' outside the assimilation interval' ) 374 354 375 355 IF ( ( ln_asmdin ).AND.( zdate_inc /= ditdin_date ) ) & … … 418 398 WHERE( ABS( seaice_bkginc(:,:) ) > 1.0e+10 ) seaice_bkginc(:,:) = 0.0 419 399 ENDIF 420 400 ! 421 401 CALL iom_close( inum ) 422 423 ENDIF 424 425 !----------------------------------------------------------------------- 426 ! Apply divergence damping filter 427 !----------------------------------------------------------------------- 428 429 IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN 430 ! 402 ! 403 ENDIF 404 ! 405 ! !-------------------------------------- 406 IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN ! Apply divergence damping filter 407 ! !-------------------------------------- 431 408 ALLOCATE( zhdiv(jpi,jpj) ) 432 409 ! … … 460 437 ! 461 438 ENDIF 462 463 !----------------------------------------------------------------------- 464 ! Allocate and initialize the background state arrays 465 !----------------------------------------------------------------------- 466 467 IF ( ln_asmdin ) THEN 468 ! 469 ALLOCATE( t_bkg(jpi,jpj,jpk) ) 470 ALLOCATE( s_bkg(jpi,jpj,jpk) ) 471 ALLOCATE( u_bkg(jpi,jpj,jpk) ) 472 ALLOCATE( v_bkg(jpi,jpj,jpk) ) 473 ALLOCATE( ssh_bkg(jpi,jpj) ) 474 ! 475 t_bkg(:,:,:) = 0._wp 476 s_bkg(:,:,:) = 0._wp 477 u_bkg(:,:,:) = 0._wp 478 v_bkg(:,:,:) = 0._wp 479 ssh_bkg(:,:) = 0._wp 439 ! 440 ! !----------------------------------------------------- 441 IF ( ln_asmdin ) THEN ! Allocate and initialize the background state arrays 442 ! !----------------------------------------------------- 443 ! 444 ALLOCATE( t_bkg (jpi,jpj,jpk) ) ; t_bkg (:,:,:) = 0._wp 445 ALLOCATE( s_bkg (jpi,jpj,jpk) ) ; s_bkg (:,:,:) = 0._wp 446 ALLOCATE( u_bkg (jpi,jpj,jpk) ) ; u_bkg (:,:,:) = 0._wp 447 ALLOCATE( v_bkg (jpi,jpj,jpk) ) ; v_bkg (:,:,:) = 0._wp 448 ALLOCATE( ssh_bkg(jpi,jpj) ) ; ssh_bkg(:,:) = 0._wp 449 ! 480 450 ! 481 451 !-------------------------------------------------------------------- … … 489 459 IF(lwp) THEN 490 460 WRITE(numout,*) 491 WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', & 492 & zdate_bkg 493 WRITE(numout,*) '~~~~~~~~~~~~' 494 ENDIF 495 ! 496 IF ( zdate_bkg /= ditdin_date ) & 461 WRITE(numout,*) ' ==>>> Assimilation background state valid at : ', zdate_bkg 462 WRITE(numout,*) 463 ENDIF 464 ! 465 IF ( zdate_bkg /= ditdin_date ) & 497 466 & CALL ctl_warn( ' Validity time of assimilation background state does', & 498 467 & ' not agree with Direct Initialization time' ) … … 521 490 ENDIF 522 491 ! 492 IF(lwp) WRITE(numout,*) ' ==>>> Euler time step switch is ', neuler 493 ! 494 IF( lk_asminc ) THEN !== data assimilation ==! 495 IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 ) ! Output background fields 496 IF( ln_asmdin ) THEN ! Direct initialization 497 IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 ) ! Tracers 498 IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics 499 IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 ) ! SSH 500 ENDIF 501 ENDIF 502 ! 523 503 END SUBROUTINE asm_inc_init 504 505 524 506 SUBROUTINE tra_asm_inc( kt ) 525 507 !!---------------------------------------------------------------------- … … 786 768 END SUBROUTINE ssh_asm_inc 787 769 770 788 771 SUBROUTINE ssh_asm_div( kt, phdivn ) 789 772 !!---------------------------------------------------------------------- … … 824 807 END SUBROUTINE ssh_asm_div 825 808 809 826 810 SUBROUTINE seaice_asm_inc( kt, kindic ) 827 811 !!---------------------------------------------------------------------- … … 886 870 ! seaice salinity balancing (to add) 887 871 #endif 888 872 ! 889 873 #if defined key_cice && defined key_asminc 890 874 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 891 875 ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rdt 892 876 #endif 893 877 ! 894 878 IF ( kt == nitiaufin_r ) THEN 895 879 DEALLOCATE( seaice_bkginc ) 896 880 ENDIF 897 881 ! 898 882 ELSE 899 883 ! 900 884 #if defined key_cice && defined key_asminc 901 885 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 902 886 #endif 903 887 ! 904 888 ENDIF 905 889 ! !----------------------------------------- … … 949 933 #if defined key_cice && defined key_asminc 950 934 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 951 952 935 #endif 953 936 ! -
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 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r9023 r9213 82 82 USE diaharm 83 83 USE diacfl 84 USE diaobs ! Observation operator 84 85 USE flo_oce ! floats variables 85 86 USE floats ! floats computation (flo_stp routine) … … 93 94 USE restart ! ocean restart (rst_wri routine) 94 95 USE prtctl ! Print control (prt_ctl routine) 95 96 USE diaobs ! Observation operator97 96 98 97 USE in_out_manager ! I/O manager -
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.