- Timestamp:
- 2009-08-06T17:56:26+02:00 (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/opa.F90
r1581 r1593 4 4 !! Ocean system : OPA ocean dynamics (including on-line tracers and sea-ice) 5 5 !!============================================================================== 6 !! History : OPA ! 1990-10 (C. Levy, G. Madec) Original code 7 !! 7.0 ! 1991-11 (M. Imbard, C. Levy, G. Madec) 8 !! 7.1 ! 1993-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 9 !! P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes ) release 7.1 10 !! - ! 1992-06 (L.Terray) coupling implementation 11 !! - ! 1993-11 (M.A. Filiberti) IGLOO sea-ice 12 !! 8.0 ! 1996-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 13 !! P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0 14 !! 8.1 ! 1997-06 (M. Imbard, G. Madec) 15 !! 8.2 ! 1999-11 (M. Imbard, H. Goosse) LIM sea-ice model 16 !! ! 1999-12 (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols) OPEN-MP 17 !! ! 2000-07 (J-M Molines, M. Imbard) Open Boundary Conditions (CLIPPER) 18 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and modules 19 !! - ! 2004-06 (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces 20 !! - ! 2004-08 (C. Talandier) New trends organization 21 !! - ! 2005-06 (C. Ethe) Add the 1D configuration possibility 22 !! - ! 2005-11 (V. Garnier) Surface pressure gradient organization 23 !! - ! 2006-03 (L. Debreu, C. Mazauric) Agrif implementation 24 !! - ! 2006-04 (G. Madec, R. Benshila) Step reorganization 25 !! - ! 2007-07 (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 26 !! 3.2 ! 2009-08 (S. Masson) open/write in the listing file in mpp 27 !!---------------------------------------------------------------------- 6 28 7 29 !!---------------------------------------------------------------------- … … 11 33 !! opa_closefile : close remaining files 12 34 !!---------------------------------------------------------------------- 13 !! History :14 !! 4.0 ! 90-10 (C. Levy, G. Madec) Original code15 !! 7.0 ! 91-11 (M. Imbard, C. Levy, G. Madec)16 !! 7.1 ! 93-03 (M. Imbard, C. Levy, G. Madec, O. Marti,17 !! M. Guyon, A. Lazar, P. Delecluse, C. Perigaud,18 !! G. Caniaux, B. Colot, C. Maes ) release 7.119 !! ! 92-06 (L.Terray) coupling implementation20 !! ! 93-11 (M.A. Filiberti) IGLOO sea-ice21 !! 8.0 ! 96-03 (M. Imbard, C. Levy, G. Madec, O. Marti,22 !! M. Guyon, A. Lazar, P. Delecluse, L.Terray,23 !! M.A. Filiberti, J. Vialar, A.M. Treguier,24 !! M. Levy) release 8.025 !! 8.1 ! 97-06 (M. Imbard, G. Madec)26 !! 8.2 ! 99-11 (M. Imbard, H. Goosse) LIM sea-ice model27 !! ! 99-12 (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols) OPEN-MP28 !! ! 00-07 (J-M Molines, M. Imbard) Open Boundary Conditions (CLIPPER)29 !! 9.0 ! 02-08 (G. Madec) F90: Free form and modules30 !! " ! 04-06 (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces31 !! " ! 04-08 (C. Talandier) New trends organization32 !! " ! 05-06 (C. Ethe) Add the 1D configuration possibility33 !! " ! 05-11 (V. Garnier) Surface pressure gradient organization34 !! " ! 06-03 (L. Debreu, C. Mazauric) Agrif implementation35 !! " ! 06-04 (G. Madec, R. Benshila) Step reorganization36 !! " ! 07-07 (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)37 !!----------------------------------------------------------------------38 !! * Modules used39 35 USE oce ! dynamics and tracers variables 40 36 USE dom_oce ! ocean space domain variables … … 42 38 USE trdmod_oce ! ocean variables trends 43 39 USE daymod ! calendar 44 USE in_out_manager ! I/O manager45 USE lib_mpp ! distributed memory computing46 47 40 USE domcfg ! domain configuration (dom_cfg routine) 48 41 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 53 46 USE bdyini ! unstructured open boundary cond. initialization (bdy_init routine) 54 47 USE istate ! initial state setting (istate_init routine) 55 USE eosbn2 ! equation of state (eos bn2 routine) 56 USE zpshde ! partial step: hor. derivative (zps_hde routine) 57 58 ! ocean physics 48 USE eosbn2 ! equation of state (eos_init routine) 59 49 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) 60 50 USE ldftra ! lateral diffusivity setting (ldftra_init routine) 61 51 USE zdfini 62 63 52 USE phycst ! physical constant (par_cst routine) 64 53 USE trdmod ! momentum/tracers trends (trd_mod_init routine) 65 66 54 USE diaptr ! poleward transports (dia_ptr_init routine) 67 68 55 USE step ! OPA time-stepping (stp routine) 69 56 #if defined key_oasis3 … … 77 64 USE dyncor_c1d ! Coriolis factor at T-point 78 65 USE step_c1d ! Time stepping loop for the 1D configuration 79 80 USE trcini ! Initialization of the passive tracers66 USE trcini ! passive tracer initialisation 67 81 68 USE iom 69 USE in_out_manager ! I/O manager 70 USE lib_mpp ! distributed memory computing 82 71 #if defined key_iomput 83 72 USE mod_ioclient … … 87 76 PRIVATE 88 77 89 !! * Module variables 90 CHARACTER (len=64) :: & 91 cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing 92 93 !! * Routine accessibility 94 PUBLIC opa_model ! called by model.F90 95 PUBLIC opa_init 96 !!---------------------------------------------------------------------- 97 !! OPA 9.0 , LOCEAN-IPSL (2005) 78 PUBLIC opa_model ! called by model.F90 79 PUBLIC opa_init ! needed by AGRIF 80 81 CHARACTER (len=64) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing 82 83 !!---------------------------------------------------------------------- 84 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 98 85 !! $Id$ 99 86 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 107 94 !! 108 95 !! ** Purpose : opa solves the primitive equations on an orthogonal 109 !! curvilinear mesh on the sphere.96 !! curvilinear mesh on the sphere. 110 97 !! 111 98 !! ** Method : - model general initialization 112 99 !! - launch the time-stepping (stp routine) 113 !! 114 !! References :115 !! Madec, Delecluse,Imbard, and Levy, 1997: reference manual.116 !! internal report, IPSL.100 !! - finalize the run by closing files and communications 101 !! 102 !! References : Madec, Delecluse,Imbard, and Levy, 1997: internal report, IPSL. 103 !! Madec, 2008, internal report, IPSL. 117 104 !!---------------------------------------------------------------------- 118 105 INTEGER :: istp ! time step index … … 120 107 121 108 #if defined key_agrif 122 CALL Agrif_Init_Grids() 123 #endif 124 125 CALL opa_init ! Initializations 109 CALL Agrif_Init_Grids() ! AGRIF: set the meshes 110 #endif 111 112 ! !-----------------------! 113 CALL opa_init !== Initialisations ==! 114 ! !-----------------------! 126 115 127 116 ! check that all process are still there... If some process have an error, … … 129 118 IF( lk_mpp ) CALL mpp_max( nstop ) 130 119 120 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 121 122 ! !-----------------------! 123 ! !== time stepping ==! 124 ! !-----------------------! 131 125 istp = nit000 132 IF( lk_c1d ) THEN ! 1D configuration (no AGRIF zoom) 133 ! 126 IF( lk_c1d ) THEN !== 1D configuration ==! 134 127 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 135 128 CALL stp_c1d( istp ) 136 129 istp = istp + 1 137 130 END DO 138 ELSE ! 3D ocean with or without AGRIF zoom 139 ! 131 ELSE !== 3D ocean with ==! 140 132 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 141 133 #if defined key_agrif 142 CALL Agrif_Step( stp ) 134 CALL Agrif_Step( stp ) ! AGRIF: time stepping 143 135 #else 144 CALL stp( istp ) 136 CALL stp( istp ) ! standard time stepping 145 137 #endif 146 138 istp = istp + 1 … … 148 140 END DO 149 141 ENDIF 150 ! ! ========= !151 ! ! Job end!152 ! ! =========!153 154 IF(lwp) WRITE(numout,cform_aaa) 155 156 IF( nstop /= 0 .AND. lwp ) THEN 142 143 ! !------------------------! 144 ! !== finalize the run ==! 145 ! !------------------------! 146 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 147 ! 148 IF( nstop /= 0 .AND. lwp ) THEN ! error print 157 149 WRITE(numout,cform_err) 158 150 WRITE(numout,*) nstop, ' error have been found' 159 151 ENDIF 160 152 ! 161 153 CALL opa_closefile 162 154 #if defined key_oasis3 || defined key_oasis4 163 call cpl_prism_finalize155 CALL cpl_prism_finalize ! end coupling and mpp communications with OASIS 164 156 #else 165 IF( lk_mpp ) CALL mppstop ! Close all files (mpp)157 IF( lk_mpp ) CALL mppstop ! end mpp communications 166 158 #endif 167 159 ! … … 177 169 !!---------------------------------------------------------------------- 178 170 #if defined key_oasis3 || defined key_oasis4 || defined key_iomput 179 INTEGER :: localComm171 INTEGER :: ilocal_comm 180 172 #endif 181 173 CHARACTER(len=80),dimension(10) :: cltxt = '' 182 INTEGER :: ji ! local loop indicees 174 INTEGER :: ji ! local loop indices 175 !! 183 176 NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle, & 184 177 & isplt , jsplt , njctls, njctle, nbench, nbit_cmp 185 178 !!---------------------------------------------------------------------- 186 187 ! Namelist namctl : Control prints & Benchmark179 ! 180 ! ! open Namelist file 188 181 CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 189 READ ( numnam, namctl ) 190 182 ! 183 READ( numnam, namctl ) ! Namelist namctl : Control prints & Benchmark 184 ! 185 ! !--------------------------------------------! 186 ! ! set communicator & select the local node ! 187 ! !--------------------------------------------! 191 188 #if defined key_iomput 192 189 # if defined key_oasis3 || defined key_oasis4 193 ! nemo local communicator given by oasis 194 CALL cpl_prism_init( localComm ) 195 ! io_server will get its communicators (if needed) from oasis (we don't see it) 196 CALL init_ioclient() 190 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 191 CALL init_ioclient() ! io_server will get its communicators (if needed) from oasis (we don't see it) 197 192 # else 198 ! nemo local communicator (used or not) given by the io_server 199 CALL init_ioclient( localcomm ) 193 CALL init_ioclient( ilocal_comm ) ! nemo local communicator (used or not) given by the io_server 200 194 # endif 201 ! Nodes selection202 narea = mynode( cltxt, localComm ) 195 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection 196 203 197 #else 204 198 # if defined key_oasis3 || defined key_oasis4 205 ! nemo local communicator given by oasis 206 CALL cpl_prism_init( localComm ) 207 ! Nodes selection 208 narea = mynode( cltxt, localComm ) 199 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 200 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection (control print return in cltxt) 209 201 # else 210 ! Nodes selection 211 narea = mynode( cltxt ) 202 narea = mynode( cltxt ) ! Nodes selection (control print return in cltxt) 212 203 # endif 213 204 #endif 214 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )215 216 lwp = narea == 1 .OR. ln_ctl ! print control217 218 IF( lwp ) THEN219 ! open listing and namelist units205 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 206 207 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 208 209 IF(lwp) THEN ! open listing units 210 ! 220 211 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 221 222 WRITE(numout,*) 223 WRITE(numout,*) ' L O D Y C - I P S L'224 WRITE(numout,*) ' O P A model'212 ! 213 WRITE(numout,*) 214 WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean' 215 WRITE(numout,*) ' NEMO team' 225 216 WRITE(numout,*) ' Ocean General Circulation Model' 226 WRITE(numout,*) ' version OPA 9.0 (2005) '227 WRITE(numout,*) 228 WRITE(numout,*) 229 DO ji = 1, SIZE(cltxt) 230 IF (TRIM(cltxt(ji)) /= '') WRITE(numout,*) cltxt(ji)217 WRITE(numout,*) ' version 3.2 (2009) ' 218 WRITE(numout,*) 219 WRITE(numout,*) 220 DO ji = 1, SIZE(cltxt) 221 IF( TRIM(cltxt(ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode 231 222 END DO 232 233 ENDIF 234 235 ! ! ============================== ! 236 ! ! Model general initialization ! 237 ! ! ============================== ! 238 239 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 223 WRITE(numout,cform_aaa) ! Flag AAAAAAA 224 ! 225 ENDIF 226 ! !--------------------------------! 227 ! ! Model general initialization ! 228 ! !--------------------------------! 240 229 241 230 CALL opa_flg ! Control prints & Benchmark 242 231 243 232 ! Domain decomposition 244 IF( jpni*jpnj == jpnij ) THEN 245 CALL mpp_init ! standard cutting out 246 ELSE 247 CALL mpp_init2 ! eliminate land processors 233 IF( jpni*jpnj == jpnij ) THEN ; CALL mpp_init ! standard cutting out 234 ELSE ; CALL mpp_init2 ! eliminate land processors 248 235 ENDIF 249 236 250 237 CALL phy_cst ! Physical constants 251 252 238 CALL eos_init ! Equation of state 253 254 239 CALL dom_cfg ! Domain configuration 255 256 240 CALL dom_init ! Domain 257 258 IF( lk_c1d ) THEN ! adaptation for1D configuration259 CALL cor_c1d ! redefine Coriolisat T-point260 umask(:,:,:) = tmask(:,:,:) 261 vmask(:,:,:) = tmask(:,:,:) 262 ENDIF 263 264 IF( ln_ctl ) CALL prt_ctl_init ! Print control 265 266 IF( lk_obc ) CALL obc_init ! Open boundaries 267 268 IF( lk_bdy ) CALL bdy_init! Unstructured open boundaries241 !!gm c1d case can be moved in dom_init routine 242 IF( lk_c1d ) THEN ! 1D configuration 243 CALL cor_c1d ! Coriolis defined at T-point 244 umask(:,:,:) = tmask(:,:,:) ! U, V and T-points are the same 245 vmask(:,:,:) = tmask(:,:,:) ! 246 ENDIF 247 !!gm c1d end 248 249 IF( ln_ctl ) CALL prt_ctl_init ! Print control 250 251 IF( lk_obc ) CALL obc_init ! Open boundaries 252 IF( lk_bdy ) CALL bdy_init ! Unstructured open boundaries 269 253 270 254 CALL istate_init ! ocean initial state (Dynamics and tracers) 271 255 272 256 ! ! Ocean physics 273 274 257 CALL ldf_dyn_init ! Lateral ocean momentum physics 275 276 258 CALL ldf_tra_init ! Lateral ocean tracer physics 277 278 259 CALL zdf_init ! Vertical ocean physics 279 260 261 CALL trc_ini ! Passive tracers 262 263 ! ! diagnostics 264 CALL iom_init( fjulday - adatrj ) ! iom_put initialization 265 CALL dia_ptr_init ! Poleward TRansports initialization 280 266 CALL trd_mod_init ! Mixed-layer/Vorticity/Integral constraints trends 281 282 283 #if defined key_top 284 CALL trc_ini ! Passive tracers 285 #endif 286 287 CALL dia_ptr_init ! Poleward TRansports initialization 288 289 CALL iom_init( fjulday - adatrj ) ! iom_put initialization 290 291 ! ! =============== ! 292 ! ! time stepping ! 293 ! ! =============== ! 294 295 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 296 267 ! 297 268 END SUBROUTINE opa_init 298 269 … … 302 273 !! *** ROUTINE opa *** 303 274 !! 304 !! ** Purpose : Initialize logical flags that control the choice of 305 !! some algorithm or control print 306 !! 307 !! ** Method : Read in namilist namflg logical flags 308 !! 309 !! History : 310 !! 9.0 ! 03-11 (G. Madec) Original code 311 !!---------------------------------------------------------------------- 312 !! * Local declarations 313 275 !! ** Purpose : Initialise logical flags that control the choice of 276 !! some algorithm or control print 277 !! 278 !! ** Method : - print namctl information 279 !! - Read in namilist namflg logical flags 280 !!---------------------------------------------------------------------- 314 281 NAMELIST/namflg/ ln_dynhpg_imp, nn_dynhpg_rst 315 282 !!---------------------------------------------------------------------- 316 283 317 ! Parameter control and print 318 ! --------------------------- 319 IF(lwp) THEN 284 IF(lwp) THEN ! Parameter print 320 285 WRITE(numout,*) 321 286 WRITE(numout,*) 'opa_flg: Control prints & Benchmark' 322 287 WRITE(numout,*) '~~~~~~~ ' 323 WRITE(numout,*) ' 324 WRITE(numout,*) ' 325 WRITE(numout,*) ' 326 WRITE(numout,*) ' 327 WRITE(numout,*) ' 328 WRITE(numout,*) ' 329 WRITE(numout,*) ' 330 WRITE(numout,*) ' 331 WRITE(numout,*) ' 332 WRITE(numout,*) ' 333 WRITE(numout,*) ' 334 ENDIF 335 336 ! ... Control the sub-domain area indices for the control prints337 IF( ln_ctl ) THEN338 IF( lk_mpp ) THEN339 ! the domain is forced to the real splitted domain in MPI340 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj288 WRITE(numout,*) ' Namelist namctl' 289 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl 290 WRITE(numout,*) ' level of print nprint = ', nprint 291 WRITE(numout,*) ' Start i indice for SUM control nictls = ', nictls 292 WRITE(numout,*) ' End i indice for SUM control nictle = ', nictle 293 WRITE(numout,*) ' Start j indice for SUM control njctls = ', njctls 294 WRITE(numout,*) ' End j indice for SUM control njctle = ', njctle 295 WRITE(numout,*) ' number of proc. following i isplt = ', isplt 296 WRITE(numout,*) ' number of proc. following j jsplt = ', jsplt 297 WRITE(numout,*) ' benchmark parameter (0/1) nbench = ', nbench 298 WRITE(numout,*) ' bit comparison mode (0/1) nbit_cmp = ', nbit_cmp 299 ENDIF 300 301 ! ! Parameter control 302 ! 303 IF( ln_ctl ) THEN ! sub-domain area indices for the control prints 304 IF( lk_mpp ) THEN 305 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real splitted domain 341 306 ELSE 342 307 IF( isplt == 1 .AND. jsplt == 1 ) THEN 343 CALL ctl_warn( ' - isplt & jsplt are equal to 1', & 344 & ' - the print control will be done over the whole domain' ) 345 ENDIF 346 347 ! compute the total number of processors ijsplt 348 ijsplt = isplt*jsplt 308 CALL ctl_warn( ' - isplt & jsplt are equal to 1', & 309 & ' - the print control will be done over the whole domain' ) 310 ENDIF 311 ijsplt = isplt * jsplt ! total number of processors ijsplt 349 312 ENDIF 350 351 313 IF(lwp) WRITE(numout,*)' - The total number of processors over which the' 352 314 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt 353 354 ! Control the indices used for the SUM control 355 IF( nictls+nictle+njctls+njctle == 0 ) THEN 356 ! the print control is done over the default area 357 lsp_area = .FALSE. 358 ELSE 359 ! the print control is done over a specific area 315 ! 316 ! ! indices used for the SUM control 317 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area 318 lsp_area = .FALSE. 319 ELSE ! print control done over a specific area 360 320 lsp_area = .TRUE. 361 321 IF( nictls < 1 .OR. nictls > jpiglo ) THEN … … 363 323 nictls = 1 364 324 ENDIF 365 366 325 IF( nictle < 1 .OR. nictle > jpiglo ) THEN 367 326 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 368 327 nictle = jpiglo 369 328 ENDIF 370 371 329 IF( njctls < 1 .OR. njctls > jpjglo ) THEN 372 330 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 373 331 njctls = 1 374 332 ENDIF 375 376 333 IF( njctle < 1 .OR. njctle > jpjglo ) THEN 377 334 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 378 335 njctle = jpjglo 379 336 ENDIF 380 381 ENDIF ! IF( nictls+nictle+njctls+njctle == 0 ) 382 ENDIF ! IF(ln_ctl) 383 384 IF( nbench == 1 ) THEN 337 ENDIF 338 ENDIF 339 340 IF( nbench == 1 ) THEN ! Benchmark 385 341 SELECT CASE ( cp_cfg ) 386 CASE ( 'gyre' ) 387 CALL ctl_warn( ' The Benchmark is activated ' ) 388 CASE DEFAULT 389 CALL ctl_stop( ' The Benchmark is based on the GYRE configuration: key_gyre must & 390 & be used or set nbench = 0' ) 342 CASE ( 'gyre' ) ; CALL ctl_warn( ' The Benchmark is activated ' ) 343 CASE DEFAULT ; CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:', & 344 & ' key_gyre must be used or set nbench = 0' ) 391 345 END SELECT 392 346 ENDIF 393 347 394 IF( nbit_cmp == 1 ) THEN 395 CALL ctl_warn( ' Bit comparison enabled. Single and multiple processor results must bit compare', & 396 & ' WARNING: RESULTS ARE NOT PHYSICAL.' ) 397 ENDIF 398 399 400 ! Read Namelist namflg : algorithm FLaG 401 ! -------------------- 402 REWIND ( numnam ) 403 READ ( numnam, namflg ) 404 405 ! Parameter control and print 406 ! --------------------------- 407 IF(lwp) THEN 348 IF( nbit_cmp == 1 ) THEN ! Bit compare 349 CALL ctl_warn( ' Bit comparison enabled. Single and multiple processor results must bit compare', & 350 & ' WARNING: RESULTS ARE NOT PHYSICAL.' ) 351 ENDIF 352 353 354 REWIND( numnam ) ! Read Namelist namflg : algorithm FLaG 355 READ ( numnam, namflg ) 356 357 IF(lwp) THEN ! Parameter print 408 358 WRITE(numout,*) 409 359 WRITE(numout,*) 'opa_flg : Hydrostatic pressure gradient algorithm' 410 360 WRITE(numout,*) '~~~~~~~' 411 WRITE(numout,*) ' Namelist namflg : set algorithm flags' 412 WRITE(numout,*) ' centered (F) or semi-implicit (T) ln_dynhpg_imp = ', ln_dynhpg_imp 413 WRITE(numout,*) ' hydrostatic pressure gradient' 414 WRITE(numout,*) ' add dynhpg implicit variable nn_dynhpg_rst = ', nn_dynhpg_rst 415 WRITE(numout,*) ' in restart ot not nn_dynhpg_rst' 416 ENDIF 361 WRITE(numout,*) ' Namelist namflg : hydrostatic pressure gradient time stepping' 362 WRITE(numout,*) ' centered (F) or semi-implicit (T) ln_dynhpg_imp = ', ln_dynhpg_imp 363 WRITE(numout,*) ' ensure restartability (=1) or not (=0) nn_dynhpg_rst = ', nn_dynhpg_rst 364 ENDIF 365 ! 417 366 IF( .NOT. ln_dynhpg_imp ) nn_dynhpg_rst = 0 ! force no adding dynhpg implicit variables in restart 418 367 ! 419 368 END SUBROUTINE opa_flg 420 369 … … 425 374 !! 426 375 !! ** Purpose : Close the files 427 !! 428 !! ** Method : 429 !! 430 !! History : 431 !! 9.0 ! 05-01 (O. Le Galloudec) Original code 432 !!---------------------------------------------------------------------- 433 !! * Modules used 376 !!---------------------------------------------------------------------- 434 377 USE dtatem ! temperature data 435 378 USE dtasal ! salinity data 436 379 !!---------------------------------------------------------------------- 437 438 IF ( lk_mpp )CALL mppsync439 380 ! 381 IF( lk_mpp ) CALL mppsync 382 ! 440 383 CLOSE( numnam ) ! namelist 441 384 CLOSE( numout ) ! standard model output file 442 385 ! 443 386 IF(lwp) CLOSE( numstp ) ! time-step file 444 387 IF(lwp) CLOSE( numsol ) ! solver file 445 388 ! 446 389 CALL iom_close ! close all input/output files 447 390 ! 448 391 END SUBROUTINE opa_closefile 449 392
Note: See TracChangeset
for help on using the changeset viewer.