- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OFF/nemogcm.F90 (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OFF/nemogcm.F90
r10601 r13463 7 7 !! 3.4 ! 2011-01 (C. Ethe, A. R. Porter, STFC Daresbury) dynamical allocation 8 8 !! 4.0 ! 2016-10 (C. Ethe, G. Madec, S. Flavoni) domain configuration / user defined interface 9 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme 9 10 !!---------------------------------------------------------------------- 10 11 … … 27 28 USE usrdef_nam ! user defined configuration 28 29 USE eosbn2 ! equation of state (eos bn2 routine) 30 #if defined key_qco 31 USE domqco ! tools for scale factor (dom_qco_r3c routine) 32 #endif 33 USE bdyini ! open boundary cond. setting (bdy_init routine) 29 34 ! ! ocean physics 30 35 USE ldftra ! lateral diffusivity setting (ldf_tra_init routine) … … 58 63 USE timing ! Timing 59 64 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 60 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 65 USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges 66 USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices 67 USE halo_mng 61 68 62 69 IMPLICIT NONE … … 88 95 !! Madec, 2008, internal report, IPSL. 89 96 !!---------------------------------------------------------------------- 90 INTEGER :: istp , indic! time step index97 INTEGER :: istp ! time step index 91 98 !!---------------------------------------------------------------------- 92 99 … … 111 118 CALL iom_setkt ( istp - nit000 + 1, cxios_context ) ! say to iom that we are at time step kstp 112 119 #if defined key_sed_off 113 CALL dta_dyn_sed( istp )! Interpolation of the dynamical fields120 CALL dta_dyn_sed( istp, Nnn ) ! Interpolation of the dynamical fields 114 121 #else 115 CALL dta_dyn ( istp ) ! Interpolation of the dynamical fields 116 IF( .NOT.ln_linssh ) CALL dta_dyn_swp( istp ) ! swap of sea surface height and vertical scale factors 117 #endif 118 CALL trc_stp ( istp ) ! time-stepping 119 CALL stp_ctl ( istp, indic ) ! Time loop: control and print 122 CALL dta_dyn ( istp, Nbb, Nnn, Naa ) ! Interpolation of the dynamical fields 123 #endif 124 #if ! defined key_sed_off 125 IF( .NOT.ln_linssh ) THEN 126 CALL dta_dyn_atf( istp, Nbb, Nnn, Naa ) ! time filter of sea surface height and vertical scale factors 127 # if defined key_qco 128 CALL dom_qco_r3c( ssh(:,:,Kmm), r3t_f, r3u_f, r3v_f ) 129 # endif 130 ENDIF 131 CALL trc_stp ( istp, Nbb, Nnn, Nrhs, Naa ) ! time-stepping 132 # if defined key_qco 133 !r3t(:,:,Kmm) = r3t_f(:,:) ! update ssh to h0 ratio 134 !r3u(:,:,Kmm) = r3u_f(:,:) 135 !r3v(:,:,Kmm) = r3v_f(:,:) 136 # endif 137 #endif 138 ! Swap time levels 139 Nrhs = Nbb 140 Nbb = Nnn 141 Nnn = Naa 142 Naa = Nrhs 143 ! 144 #if ! defined key_qco 145 #if ! defined key_sed_off 146 IF( .NOT.ln_linssh ) CALL dta_dyn_sf_interp( istp, Nnn ) ! calculate now grid parameters 147 #endif 148 #endif 149 CALL stp_ctl ( istp ) ! Time loop: control and print 120 150 istp = istp + 1 121 151 END DO … … 131 161 132 162 IF( nstop /= 0 .AND. lwp ) THEN ! error print 133 WRITE( numout,cform_err)134 WRITE( numout,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found'135 WRITE(numout,*)163 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 164 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 165 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 136 166 ENDIF 137 167 ! … … 146 176 #endif 147 177 ! 178 IF(lwm) THEN 179 IF( nstop == 0 ) THEN ; STOP 0 180 ELSE ; STOP 123 181 ENDIF 182 ENDIF 183 ! 148 184 END SUBROUTINE nemo_gcm 149 185 … … 155 191 !! ** Purpose : initialization of the nemo model in off-line mode 156 192 !!---------------------------------------------------------------------- 157 INTEGER :: ji ! dummy loop indices 158 INTEGER :: ios, ilocal_comm ! local integers 159 CHARACTER(len=120), DIMENSION(30) :: cltxt, cltxt2, clnam 160 !! 161 NAMELIST/namctl/ ln_ctl , sn_cfctl, nn_print, nn_ictls, nn_ictle, & 162 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 163 & ln_timing, ln_diacfl 193 INTEGER :: ios, ilocal_comm ! local integers 194 !! 195 NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, & 196 & nn_isplt, nn_jsplt, nn_ictls, nn_ictle, nn_jctls, nn_jctle 164 197 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 165 198 !!---------------------------------------------------------------------- 166 199 ! 167 cltxt = ''168 cltxt2 = ''169 clnam = ''170 200 cxios_context = 'nemo' 171 ! 172 ! ! Open reference namelist and configuration namelist files 173 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 174 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 175 ! 176 REWIND( numnam_ref ) ! Namelist namctl in reference namelist 201 nn_hls = 1 202 ! 203 ! !-------------------------------------------------! 204 ! ! set communicator & select the local rank ! 205 ! ! must be done as soon as possible to get narea ! 206 ! !-------------------------------------------------! 207 ! 208 #if defined key_iomput 209 CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm ) ! nemo local communicator given by xios 210 CALL mpp_start( ilocal_comm ) 211 #else 212 CALL mpp_start( ) 213 #endif 214 ! 215 narea = mpprank + 1 ! mpprank: the rank of proc (0 --> mppsize -1 ) 216 lwm = (narea == 1) ! control of output namelists 217 ! 218 ! !---------------------------------------------------------------! 219 ! ! Open output files, reference and configuration namelist files ! 220 ! !---------------------------------------------------------------! 221 ! 222 ! open ocean.output as soon as possible to get all output prints (including errors messages) 223 IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 224 ! open reference and configuration namelist files 225 CALL load_nml( numnam_ref, 'namelist_ref', -1, lwm ) 226 CALL load_nml( numnam_cfg, 'namelist_cfg', -1, lwm ) 227 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 228 ! open /dev/null file to be able to supress output write easily 229 IF( Agrif_Root() ) THEN 230 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 231 #ifdef key_agrif 232 ELSE 233 numnul = Agrif_Parent(numnul) 234 #endif 235 ENDIF 236 ! 237 ! !--------------------! 238 ! ! Open listing units ! -> need sn_cfctl from namctl to define lwp 239 ! !--------------------! 240 ! 177 241 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 178 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 179 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist 242 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist' ) 180 243 READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 181 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 182 ! 183 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist 184 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 185 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 186 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist 187 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 188 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 189 190 ! !--------------------------! 191 ! ! Set global domain size ! (control print return in cltxt2) 192 ! !--------------------------! 193 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 194 CALL domain_cfg ( cltxt2, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 195 ! 196 ELSE ! user-defined namelist 197 CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 198 ENDIF 199 ! 200 l_offline = .true. ! passive tracers are run offline 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 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) 209 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 210 #else 211 ilocal_comm = 0 212 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 213 #endif 214 215 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 216 217 IF( sn_cfctl%l_config ) THEN 218 ! Activate finer control of report outputs 219 ! optionally switch off output from selected areas (note this only 220 ! applies to output which does not involve global communications) 221 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 222 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 223 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 224 ELSE 225 ! Use ln_ctl to turn on or off all options. 226 CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 227 ENDIF 228 229 lwm = (narea == 1) ! control of output namelists 230 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 231 232 IF(lwm) THEN ! write merged namelists from earlier to output namelist 233 ! ! now that the file has been opened in call to mynode. 234 ! ! NB: nammpp has already been written in mynode (if lk_mpp_mpi) 235 WRITE( numond, namctl ) 236 WRITE( numond, namcfg ) 237 IF( .NOT.ln_read_cfg ) THEN 238 DO ji = 1, SIZE(clnam) 239 IF( TRIM(clnam(ji)) /= '' ) WRITE(numond, * ) clnam(ji) ! namusr_def print 240 END DO 241 ENDIF 242 ENDIF 243 244 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist' ) 245 ! 246 ! finalize the definition of namctl variables 247 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 248 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 249 ! 250 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print 251 ! 244 252 IF(lwp) THEN ! open listing units 245 253 ! 246 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 254 IF( .NOT. lwm ) & ! alreay opened for narea == 1 255 & CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 247 256 ! 248 257 WRITE(numout,*) 249 WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV -CMCC'258 WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC' 250 259 WRITE(numout,*) ' NEMO team' 251 260 WRITE(numout,*) ' Off-line TOP Model' … … 266 275 WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 267 276 WRITE(numout,*) 268 DO ji = 1, SIZE(cltxt)269 IF( TRIM(cltxt (ji)) /= '' ) WRITE(numout,*) TRIM(cltxt(ji)) ! control print of mynode270 END DO271 WRITE(numout,*)272 WRITE(numout,*)273 DO ji = 1, SIZE(cltxt2)274 IF( TRIM(cltxt2(ji)) /= '' ) WRITE(numout,*) TRIM(cltxt2(ji)) ! control print of domain size275 END DO276 277 ! 277 278 WRITE(numout,cform_aaa) ! Flag AAAAAAA 278 279 ! 279 280 ENDIF 280 ! open /dev/null file to be able to supress output write easily 281 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 282 ! 283 ! ! Domain decomposition 284 CALL mpp_init ! MPP 285 281 ! 282 IF(lwm) WRITE( numond, namctl ) 283 ! 284 ! !------------------------------------! 285 ! ! Set global domain size parameters ! 286 ! !------------------------------------! 287 ! 288 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 289 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 290 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 291 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 292 ! 293 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 294 CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 295 ELSE ! user-defined namelist 296 CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 297 ENDIF 298 ! 299 IF(lwm) WRITE( numond, namcfg ) 300 l_offline = .true. ! passive tracers are run offline 301 ! 302 ! !-----------------------------------------! 303 ! ! mpp parameters and domain decomposition ! 304 ! !-----------------------------------------! 305 ! 306 CALL mpp_init 307 308 CALL halo_mng_init() 286 309 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 287 310 CALL nemo_alloc() 311 312 ! Initialise time level indices 313 Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 288 314 289 315 ! !-------------------------------! … … 300 326 CALL eos_init ! Equation of state 301 327 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 302 CALL dom_init("OPA") ! Domain 303 IF( ln_ctl ) CALL prt_ctl_init ! Print control 304 305 CALL istate_init ! ocean initial state (Dynamics and tracers) 306 307 CALL sbc_init ! Forcings : surface module 328 CALL dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 329 IF( sn_cfctl%l_prtctl ) & 330 & CALL prt_ctl_init ! Print control 331 332 CALL istate_init( Nnn, Naa ) ! ocean initial state (Dynamics and tracers) 333 334 CALL sbc_init( Nbb, Nnn, Naa ) ! Forcings : surface module 335 CALL bdy_init ! Open boundaries initialisation 308 336 309 337 ! ! Tracer physics … … 319 347 CALL trc_rst_cal( nit000, 'READ' ) ! calendar 320 348 #if defined key_sed_off 321 CALL dta_dyn_sed_init ! Initialization for the dynamics349 CALL dta_dyn_sed_init( Nnn ) ! Initialization for the dynamics 322 350 #else 323 CALL dta_dyn_init ! Initialization for the dynamics324 #endif 325 326 CALL trc_init ! Passive tracers initialization351 CALL dta_dyn_init( Nbb, Nnn, Naa ) ! Initialization for the dynamics 352 #endif 353 354 CALL trc_init( Nbb, Nnn, Naa ) ! Passive tracers initialization 327 355 CALL dia_ptr_init ! Poleward TRansports initialization 328 356 … … 340 368 !! ** Purpose : control print setting 341 369 !! 342 !! ** Method : - print namctl information and check some consistencies370 !! ** Method : - print namctl and namcfg information and check some consistencies 343 371 !!---------------------------------------------------------------------- 344 372 ! … … 348 376 WRITE(numout,*) '~~~~~~~~' 349 377 WRITE(numout,*) ' Namelist namctl' 350 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl351 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config352 378 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 353 379 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 354 380 WRITE(numout,*) ' sn_cfctl%l_oceout = ', sn_cfctl%l_oceout 355 381 WRITE(numout,*) ' sn_cfctl%l_layout = ', sn_cfctl%l_layout 356 WRITE(numout,*) ' sn_cfctl%l_mppout = ', sn_cfctl%l_mppout 357 WRITE(numout,*) ' sn_cfctl%l_mpptop = ', sn_cfctl%l_mpptop 382 WRITE(numout,*) ' sn_cfctl%l_prtctl = ', sn_cfctl%l_prtctl 383 WRITE(numout,*) ' sn_cfctl%l_prttrc = ', sn_cfctl%l_prttrc 384 WRITE(numout,*) ' sn_cfctl%l_oasout = ', sn_cfctl%l_oasout 358 385 WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin 359 386 WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax 360 387 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 361 388 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 362 WRITE(numout,*) ' level of print nn_print = ', nn_print363 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls364 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle365 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls366 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle367 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt368 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt369 389 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 370 390 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl 371 391 ENDIF 372 ! 373 nprint = nn_print ! convert DOCTOR namelist names into OLD names 374 nictls = nn_ictls 375 nictle = nn_ictle 376 njctls = nn_jctls 377 njctle = nn_jctle 378 isplt = nn_isplt 379 jsplt = nn_jsplt 380 392 393 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file 381 394 IF(lwp) THEN ! control print 382 395 WRITE(numout,*) … … 389 402 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 390 403 ENDIF 391 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file392 !393 ! ! Parameter control394 !395 IF( ln_ctl ) THEN ! sub-domain area indices for the control prints396 IF( lk_mpp .AND. jpnij > 1 ) THEN397 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain398 ELSE399 IF( isplt == 1 .AND. jsplt == 1 ) THEN400 CALL ctl_warn( ' - isplt & jsplt are equal to 1', &401 & ' - the print control will be done over the whole domain' )402 ENDIF403 ijsplt = isplt * jsplt ! total number of processors ijsplt404 ENDIF405 IF(lwp) WRITE(numout,*)' - The total number of processors over which the'406 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt407 !408 ! ! indices used for the SUM control409 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area410 lsp_area = .FALSE.411 ELSE ! print control done over a specific area412 lsp_area = .TRUE.413 IF( nictls < 1 .OR. nictls > jpiglo ) THEN414 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )415 nictls = 1416 ENDIF417 IF( nictle < 1 .OR. nictle > jpiglo ) THEN418 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )419 nictle = jpiglo420 ENDIF421 IF( njctls < 1 .OR. njctls > jpjglo ) THEN422 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )423 njctls = 1424 ENDIF425 IF( njctle < 1 .OR. njctle > jpjglo ) THEN426 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )427 njctle = jpjglo428 ENDIF429 ENDIF430 ENDIF431 404 ! 432 405 IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', & … … 448 421 ! 449 422 IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file 450 IF( numnam_ref /= -1 ) CLOSE( numnam_ref ) ! oce reference namelist451 IF( numnam_cfg /= -1 ) CLOSE( numnam_cfg ) ! oce configuration namelist452 IF( numout /= 6 ) CLOSE( numout ) ! standard model output file453 423 IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist 454 424 ! … … 470 440 USE zdf_oce, ONLY : zdf_oce_alloc 471 441 USE trc_oce, ONLY : trc_oce_alloc 442 USE bdy_oce, ONLY : bdy_oce_alloc 472 443 ! 473 444 INTEGER :: ierr … … 479 450 ierr = ierr + zdf_oce_alloc() ! ocean vertical physics 480 451 ierr = ierr + trc_oce_alloc() ! shared TRC / TRA arrays 452 ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization) 481 453 ! 482 454 CALL mpp_sum( 'nemogcm', ierr ) … … 485 457 END SUBROUTINE nemo_alloc 486 458 487 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto , for_all)459 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 488 460 !!---------------------------------------------------------------------- 489 461 !! *** ROUTINE nemo_set_cfctl *** 490 462 !! 491 463 !! ** Purpose : Set elements of the output control structure to setto. 492 !! for_all should be .false. unless all areas are to be 493 !! treated identically. 494 !! 464 !! 495 465 !! ** Method : Note this routine can be used to switch on/off some 496 !! types of output for selected areas but any output types 497 !! that involve global communications (e.g. mpp_max, glob_sum) 498 !! should be protected from selective switching by the 499 !! for_all argument 500 !!---------------------------------------------------------------------- 501 LOGICAL :: setto, for_all 502 TYPE(sn_ctl) :: sn_cfctl 503 !!---------------------------------------------------------------------- 504 IF( for_all ) THEN 505 sn_cfctl%l_runstat = setto 506 sn_cfctl%l_trcstat = setto 507 ENDIF 466 !! types of output for selected areas. 467 !!---------------------------------------------------------------------- 468 TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 469 LOGICAL , INTENT(in ) :: setto 470 !!---------------------------------------------------------------------- 471 sn_cfctl%l_runstat = setto 472 sn_cfctl%l_trcstat = setto 508 473 sn_cfctl%l_oceout = setto 509 474 sn_cfctl%l_layout = setto 510 sn_cfctl%l_mppout = setto 511 sn_cfctl%l_mpptop = setto 475 sn_cfctl%l_prtctl = setto 476 sn_cfctl%l_prttrc = setto 477 sn_cfctl%l_oasout = setto 512 478 END SUBROUTINE nemo_set_cfctl 513 479 514 SUBROUTINE istate_init 480 SUBROUTINE istate_init( Kmm, Kaa ) 515 481 !!---------------------------------------------------------------------- 516 482 !! *** ROUTINE istate_init *** … … 518 484 !! ** Purpose : Initialization to zero of the dynamics and tracers. 519 485 !!---------------------------------------------------------------------- 486 INTEGER, INTENT(in) :: Kmm, Kaa ! ocean time level indices 520 487 ! 521 488 ! now fields ! after fields ! 522 u n (:,:,:) = 0._wp ; ua(:,:,:) = 0._wp !523 v n (:,:,:) = 0._wp ; va(:,:,:) = 0._wp !524 w n(:,:,:) = 0._wp ! !525 hdiv n(:,:,:) = 0._wp ! !526 ts n (:,:,:,:) = 0._wp ! !489 uu (:,:,:,Kmm) = 0._wp ; uu(:,:,:,Kaa) = 0._wp ! 490 vv (:,:,:,Kmm) = 0._wp ; vv(:,:,:,Kaa) = 0._wp ! 491 ww (:,:,:) = 0._wp ! ! 492 hdiv (:,:,:) = 0._wp ! ! 493 ts (:,:,:,:,Kmm) = 0._wp ! ! 527 494 ! 528 495 rhd (:,:,:) = 0.e0 … … 533 500 534 501 535 SUBROUTINE stp_ctl( kt , kindic)502 SUBROUTINE stp_ctl( kt ) 536 503 !!---------------------------------------------------------------------- 537 504 !! *** ROUTINE stp_ctl *** … … 544 511 !!---------------------------------------------------------------------- 545 512 INTEGER, INTENT(in ) :: kt ! ocean time-step index 546 INTEGER, INTENT(inout) :: kindic ! indicator of solver convergence547 513 !!---------------------------------------------------------------------- 548 514 !
Note: See TracChangeset
for help on using the changeset viewer.
