Changeset 11831 for NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/tests/STATION_ASF/MY_SRC/nemogcm.F90
- Timestamp:
- 2019-10-29T18:14:49+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/tests/STATION_ASF/MY_SRC/nemogcm.F90
r11637 r11831 5 5 !!====================================================================== 6 6 !! History : 3.6 ! 2011-11 (S. Alderson, G. Madec) original code 7 !! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 7 !! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 8 8 !! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla) 9 9 !! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface … … 11 11 12 12 !!---------------------------------------------------------------------- 13 !! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry 13 !! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 14 14 !! nemo_init : initialization of the NEMO system 15 15 !! nemo_ctl : initialisation of the contol print … … 17 17 !! nemo_alloc : dynamical allocation 18 18 !!---------------------------------------------------------------------- 19 USE step_oce ! module used in the ocean time stepping module 19 USE step_oce ! module used in the ocean time stepping module (step.F90) 20 20 USE sbc_oce ! surface boundary condition: ocean 21 21 USE phycst ! physical constant (par_cst routine) … … 26 26 USE restart ! open restart file 27 27 !LB:USE step ! NEMO time-stepping (stp routine) 28 !LB:USE cpl_oasis3 !29 28 USE c1d ! 1D configuration 30 29 USE step_c1d ! Time stepping loop for the 1D configuration 31 30 USE sbcssm ! 32 !LB:USE icbini ! handle bergs, initialisation33 !LB:USE icbstp ! handle bergs, calving, themodynamics and transport34 !LB:USE bdyini ! open boundary cond. setting (bdy_init routine). mandatory for sea-ice35 !LB:USE bdydta ! open boundary cond. setting (bdy_dta_init routine). mandatory for sea-ice36 31 ! 37 32 USE lib_mpp ! distributed memory computing 38 33 USE mppini ! shared/distributed memory setting (mpp_init routine) 39 !LB:USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges40 34 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 41 35 #if defined key_iomput … … 52 46 53 47 !!---------------------------------------------------------------------- 54 !! NEMO/ SAS4.0 , NEMO Consortium (2018)55 !! $Id: nemogcm.F90 1 0601 2019-01-28 20:53:01Z acc$48 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 49 !! $Id: nemogcm.F90 11536 2019-09-11 13:54:18Z smasson $ 56 50 !! Software governed by the CeCILL license (see ./LICENSE) 57 51 !!---------------------------------------------------------------------- … … 73 67 !!---------------------------------------------------------------------- 74 68 INTEGER :: istp ! time step index 69 REAL(wp):: zstptiming ! elapsed time for 1 time step 75 70 !!---------------------------------------------------------------------- 76 71 ! … … 99 94 ! 100 95 DO WHILE( istp <= nitend .AND. nstop == 0 ) 101 #if defined key_mpp_mpi 96 102 97 ncom_stp = istp 103 IF ( istp == ( nit000 + 1 ) ) elapsed_time = MPI_Wtime() 104 IF ( istp == nitend ) elapsed_time = MPI_Wtime() - elapsed_time 105 #endif 106 CALL stp ( istp ) 98 IF( ln_timing ) THEN 99 zstptiming = MPI_Wtime() 100 IF ( istp == ( nit000 + 1 ) ) elapsed_time = zstptiming 101 IF ( istp == nitend ) elapsed_time = zstptiming - elapsed_time 102 ENDIF 103 104 CALL stp ( istp ) 107 105 istp = istp + 1 106 107 IF( lwp .AND. ln_timing ) WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 108 108 109 END DO 109 110 ! … … 111 112 ! 112 113 DO WHILE( istp <= nitend .AND. nstop == 0 ) 113 CALL stp_diurnal( istp ) ! time step only the diurnal SST 114 CALL stp_diurnal( istp ) ! time step only the diurnal SST 114 115 istp = istp + 1 115 116 END DO … … 125 126 ! 126 127 IF( nstop /= 0 .AND. lwp ) THEN ! error print 127 WRITE(numout,cform_err) 128 WRITE(numout,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 129 WRITE(numout,*) 128 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 129 CALL ctl_stop( ctmp1 ) 130 130 ENDIF 131 131 ! … … 135 135 ! 136 136 #if defined key_iomput 137 137 CALL xios_finalize ! end mpp communications with xios 138 138 #else 139 IF( lk_mpp ) THEN ; CALL mppstop ( ldfinal = .TRUE. )! end mpp communications139 IF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications 140 140 ENDIF 141 141 #endif … … 143 143 IF(lwm) THEN 144 144 IF( nstop == 0 ) THEN ; STOP 0 145 ELSE ; STOP 999145 ELSE ; STOP 123 146 146 ENDIF 147 147 ENDIF … … 156 156 !! ** Purpose : initialization of the NEMO GCM 157 157 !!---------------------------------------------------------------------- 158 INTEGER :: ji ! dummy loop indices 159 INTEGER :: ios, ilocal_comm ! local integers 160 CHARACTER(len=120), DIMENSION(60) :: cltxt, cltxt2, clnam 158 INTEGER :: ios, ilocal_comm ! local integers 161 159 !! 162 160 NAMELIST/namctl/ ln_ctl , sn_cfctl, nn_print, nn_ictls, nn_ictle, & … … 166 164 !!---------------------------------------------------------------------- 167 165 ! 168 cltxt = ''169 cltxt2 = ''170 clnam = ''171 166 cxios_context = 'nemo' 172 167 ! 173 ! ! Open reference namelist and configuration namelist files 174 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 175 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 168 ! !-------------------------------------------------! 169 ! ! set communicator & select the local rank ! 170 ! ! must be done as soon as possible to get narea ! 171 ! !-------------------------------------------------! 172 ! 173 #if defined key_iomput 174 IF( Agrif_Root() ) THEN 175 CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm ) ! nemo local communicator given by xios 176 ENDIF 177 CALL mpp_start( ilocal_comm ) 178 #else 179 CALL mpp_start( ) 180 #endif 181 ! 182 narea = mpprank + 1 ! mpprank: the rank of proc (0 --> mppsize -1 ) 183 lwm = (narea == 1) ! control of output namelists 184 ! 185 ! !---------------------------------------------------------------! 186 ! ! Open output files, reference and configuration namelist files ! 187 ! !---------------------------------------------------------------! 188 ! 189 ! open ocean.output as soon as possible to get all output prints (including errors messages) 190 IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 191 ! open reference and configuration namelist files 192 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 193 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 194 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 195 ! open /dev/null file to be able to supress output write easily 196 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 197 ! 198 ! !--------------------! 199 ! ! Open listing units ! -> need ln_ctl from namctl to define lwp 200 ! !--------------------! 176 201 ! 177 202 REWIND( numnam_ref ) ! Namelist namctl in reference namelist 178 203 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 179 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist' , .TRUE.)204 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist' ) 180 205 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist 181 206 READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 182 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 183 ! 184 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist 185 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 186 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 187 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist 188 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 189 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 190 191 ! !--------------------------! 192 ! ! Set global domain size ! (control print return in cltxt2) 193 ! !--------------------------! 194 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 195 CALL domain_cfg ( cltxt2, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 196 ! 197 ELSE ! user-defined namelist 198 CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 199 ENDIF 200 ! 201 ! 202 ! !--------------------------------------------! 203 ! ! set communicator & select the local node ! 204 ! ! NB: mynode also opens output.namelist.dyn ! 205 ! ! on unit number numond on first proc ! 206 ! !--------------------------------------------! 207 #if defined key_iomput 208 IF( Agrif_Root() ) THEN 209 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios 210 ENDIF 211 ! Nodes selection (control print return in cltxt) 212 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 213 #else 214 ilocal_comm = 0 ! Nodes selection (control print return in cltxt) 215 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 216 #endif 217 218 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 219 220 IF( sn_cfctl%l_config ) THEN 221 ! Activate finer control of report outputs 222 ! optionally switch off output from selected areas (note this only 223 ! applies to output which does not involve global communications) 224 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 225 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 226 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 227 ELSE 228 ! Use ln_ctl to turn on or off all options. 229 CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 230 ENDIF 231 232 lwm = (narea == 1) ! control of output namelists 233 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 234 235 IF(lwm) THEN ! write merged namelists from earlier to output namelist 236 ! ! now that the file has been opened in call to mynode. 237 ! ! NB: nammpp has already been written in mynode (if lk_mpp_mpi) 238 WRITE( numond, namctl ) 239 WRITE( numond, namcfg ) 240 IF( .NOT.ln_read_cfg ) THEN 241 DO ji = 1, SIZE(clnam) 242 IF( TRIM(clnam(ji)) /= '' ) WRITE(numond, * ) clnam(ji) ! namusr_def print 243 END DO 244 ENDIF 245 ENDIF 246 247 IF(lwp) THEN ! open listing units 248 ! 249 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 207 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist' ) 208 ! 209 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 210 ! 211 IF(lwp) THEN ! open listing units 212 ! 213 IF( .NOT. lwm ) & ! alreay opened for narea == 1 214 & CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 250 215 ! 251 216 WRITE(numout,*) 252 WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV -CMCC'217 WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC' 253 218 WRITE(numout,*) ' NEMO team' 254 219 WRITE(numout,*) ' Ocean General Circulation Model' 255 220 WRITE(numout,*) ' NEMO version 4.0 (2019) ' 256 WRITE(numout,*) ' SASC1D'221 WRITE(numout,*) ' STATION_ASF ' 257 222 WRITE(numout,*) " ._ ._ ._ ._ ._ " 258 223 WRITE(numout,*) " _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ " … … 269 234 WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 270 235 WRITE(numout,*) 271 272 DO ji = 1, SIZE(cltxt)273 IF( TRIM(cltxt (ji)) /= '' ) WRITE(numout,*) TRIM(cltxt(ji)) ! control print of mynode274 END DO275 WRITE(numout,*)276 WRITE(numout,*)277 DO ji = 1, SIZE(cltxt2)278 IF( TRIM(cltxt2(ji)) /= '' ) WRITE(numout,*) TRIM(cltxt2(ji)) ! control print of domain size279 END DO280 236 ! 281 237 WRITE(numout,cform_aaa) ! Flag AAAAAAA 282 238 ! 283 239 ENDIF 284 ! open /dev/null file to be able to supress output write easily 285 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 286 ! 287 ! ! Domain decomposition 288 CALL mpp_init ! MPP 240 ! 241 ! finalize the definition of namctl variables 242 IF( sn_cfctl%l_config ) THEN 243 ! Activate finer control of report outputs 244 ! optionally switch off output from selected areas (note this only 245 ! applies to output which does not involve global communications) 246 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 247 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 248 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 249 ELSE 250 ! Use ln_ctl to turn on or off all options. 251 CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 252 ENDIF 253 ! 254 IF(lwm) WRITE( numond, namctl ) 255 ! 256 ! !------------------------------------! 257 ! ! Set global domain size parameters ! 258 ! !------------------------------------! 259 ! 260 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist 261 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 262 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 263 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist 264 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 265 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 266 ! 267 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 268 CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 269 ELSE ! user-defined namelist 270 CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 271 ENDIF 272 ! 273 IF(lwm) WRITE( numond, namcfg ) 274 ! 275 ! !-----------------------------------------! 276 ! ! mpp parameters and domain decomposition ! 277 ! !-----------------------------------------! 278 CALL mpp_init 289 279 290 280 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays … … 301 291 IF( ln_timing ) CALL timing_start( 'nemo_init') 302 292 ! 303 CALL phy_cst ! Physical constants 304 CALL eos_init ! Equation of state 305 !LB: CALL dom_init('SAS') ! Domain 306 IF( lk_c1d ) CALL c1d_init ! 1D column configuration !LB 307 CALL dom_init("OPA") ! Domain 293 CALL phy_cst ! Physical constants 294 CALL eos_init ! Equation of state 295 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 296 CALL dom_init("OPA") ! Domain 308 297 IF( ln_ctl ) CALL prt_ctl_init ! Print control 309 !PRINT *, 'LOLO/nemogcm.F90: after prt_ctl_init!'; STOP 310 311 CALL day_init ! model calendar (using both namelist and restart infos) 298 299 CALL day_init ! model calendar (using both namelist and restart infos) 312 300 IF( ln_rstart ) CALL rst_read_open 313 301 314 ! ! external forcing 315 CALL sbc_init ! Forcings : surface module 316 317 ! ==> clem: open boundaries init. is mandatory for sea-ice because ice BDY is not decoupled from 318 ! the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules. 319 ! This is not clean and should be changed in the future. 320 !CALL bdy_init 302 ! ! external forcing 303 CALL sbc_init ! surface boundary conditions (including sea-ice) 304 321 305 ! 322 306 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA … … 333 317 !! ** Purpose : control print setting 334 318 !! 335 !! ** Method : - print namctl information and check some consistencies319 !! ** Method : - print namctl and namcfg information and check some consistencies 336 320 !!---------------------------------------------------------------------- 337 321 ! … … 349 333 WRITE(numout,*) ' sn_cfctl%l_mppout = ', sn_cfctl%l_mppout 350 334 WRITE(numout,*) ' sn_cfctl%l_mpptop = ', sn_cfctl%l_mpptop 351 WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin 352 WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax 353 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 354 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 335 WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin 336 WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax 337 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 338 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 355 339 WRITE(numout,*) ' level of print nn_print = ', nn_print 356 340 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls … … 467 451 USE diawri , ONLY : dia_wri_alloc 468 452 USE dom_oce , ONLY : dom_oce_alloc 469 !USE bdy_oce , ONLY : ln_bdy, bdy_oce_alloc470 USE oce ! mandatory for sea-ice because needed for bdy arrays471 453 ! 472 454 INTEGER :: ierr 473 455 !!---------------------------------------------------------------------- 474 456 ! 475 ierr = dia_wri_alloc() 476 ierr = ierr + dom_oce_alloc() ! ocean domain 477 ierr = ierr + oce_alloc () ! (tsn...) needed for agrif and/or SI3 and bdy 478 !ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization) 457 ierr = oce_alloc () ! ocean 458 ierr = ierr + dia_wri_alloc() 459 ierr = ierr + dom_oce_alloc() ! ocean domain 479 460 ! 480 461 CALL mpp_sum( 'nemogcm', ierr ) … … 482 463 ! 483 464 END SUBROUTINE nemo_alloc 465 484 466 485 467 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) … … 512 494 !!====================================================================== 513 495 END MODULE nemogcm 514
Note: See TracChangeset
for help on using the changeset viewer.
