Changeset 2528 for trunk/NEMOGCM/NEMO/OFF_SRC/opa.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OFF_SRC/opa.F90 (modified) (8 diffs, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OFF_SRC/opa.F90
- Property svn:eol-style deleted
r1749 r2528 1 1 MODULE opa 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE opa *** 4 !! Ocean system : OPA ocean dynamics (including on-line tracers and sea-ice) 5 !!============================================================================== 6 7 !!---------------------------------------------------------------------- 8 !! opa_model : solve ocean dynamics, tracer and/or sea-ice 9 !!---------------------------------------------------------------------- 10 !! * Modules used 4 !! Off-line Ocean : passive tracer evolution, dynamics read in files 5 !!====================================================================== 6 !! History : 3.3 ! 2010-05 (C. Ethe) Full reorganization of the off-line: phasing with the on-line 7 !!---------------------------------------------------------------------- 8 9 !!---------------------------------------------------------------------- 10 !! opa_model : off-line: solve ocean tracer only 11 !! opa_init : initialization of the opa model 12 !! opa_ctl : initialisation of algorithm flag 13 !! opa_closefile : close remaining files 14 !!---------------------------------------------------------------------- 11 15 USE dom_oce ! ocean space domain variables 12 16 USE oce ! dynamics and tracers variables 13 USE in_out_manager ! I/O manager 14 USE lib_mpp ! distributed memory computing 15 17 USE c1d ! 1D configuration 16 18 USE domcfg ! domain configuration (dom_cfg routine) 17 USE mppini ! shared/distributed memory setting (mpp_init routine)18 19 USE domain ! domain initialization (dom_init routine) 19 20 USE istate ! initial state setting (istate_init routine) 20 21 USE eosbn2 ! equation of state (eos bn2 routine) 21 22 ! ocean physics 23 USE ldftra ! lateral diffusivity setting (ldftra_init routine) 24 USE traqsr ! solar radiation penetration (tra_qsr_init routine) 25 22 ! ! ocean physics 23 USE ldftra ! lateral diffusivity setting (ldf_tra_init routine) 24 USE ldfslp ! slopes of neutral surfaces (ldf_slp_init routine) 25 USE traqsr ! solar radiation penetration (tra_qsr_init routine) 26 USE trabbl ! bottom boundary layer (tra_bbl_init routine) 27 USE zdfini ! vertical physics: initialization 26 28 USE phycst ! physical constant (par_cst routine) 27 29 USE dtadyn ! Lecture and Interpolation of the dynamical fields 28 30 USE trcini ! Initilization of the passive tracers 29 USE step ! OPA time-stepping (stp routine) 30 31 USE iom 31 USE daymod ! calendar (day routine) 32 USE trcstp ! passive tracer time-stepping (trc_stp routine) 33 USE dtadyn ! Lecture and interpolation of the dynamical fields 34 USE stpctl ! time stepping control (stp_ctl routine) 35 ! ! I/O & MPP 36 USE iom ! I/O library 37 USE in_out_manager ! I/O manager 38 USE mppini ! shared/distributed memory setting (mpp_init routine) 39 USE lib_mpp ! distributed memory computing 32 40 #if defined key_iomput 33 41 USE mod_ioclient … … 36 44 IMPLICIT NONE 37 45 PRIVATE 38 39 !! * Module variables 40 CHARACTER (len=64) :: & 41 cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing 42 43 !! * Routine accessibility 44 PUBLIC opa_model ! called by model.F90 45 PUBLIC opa_init 46 !!---------------------------------------------------------------------- 47 !! OPA 9.0 , LOCEAN-IPSL (2005) 48 !! $Id$ 49 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 50 !!---------------------------------------------------------------------- 51 46 47 PUBLIC opa_model ! called by model.F90 48 49 CHARACTER (len=64) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing 50 51 !!---------------------------------------------------------------------- 52 !! NEMO/OFF 3.3 , NEMO Consortium (2010) 53 !! $Id$ 54 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 55 !!---------------------------------------------------------------------- 52 56 CONTAINS 53 57 … … 60 64 !! 61 65 !! ** Method : - model general initialization 62 !! - launch the time-stepping ( stp routine)63 !! 64 !! References :65 !! Madec, Delecluse,Imbard, and Levy, 1997: reference manual.66 !! internal report, IPSL.67 !!---------------------------------------------------------------------- 68 INTEGER :: istp! time step index66 !! - launch the time-stepping (dta_dyn and trc_stp) 67 !! - finalize the run by closing files and communications 68 !! 69 !! References : Madec, Delecluse,Imbard, and Levy, 1997: internal report, IPSL. 70 !! Madec, 2008, internal report, IPSL. 71 !!---------------------------------------------------------------------- 72 INTEGER :: istp, indic ! time step index 69 73 !!---------------------------------------------------------------------- 70 74 … … 77 81 IF( lk_mpp ) CALL mpp_max( nstop ) 78 82 83 ! !-----------------------! 84 ! !== time stepping ==! 85 ! !-----------------------! 79 86 istp = nit000 80 87 ! 81 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 82 CALL stp( istp ) 88 DO WHILE ( istp <= nitend .AND. nstop == 0 ) ! time stepping 89 ! 90 IF( istp /= nit000 ) CALL day ( istp ) ! Calendar (day was already called at nit000 in day_init) 91 CALL iom_setkt( istp ) ! say to iom that we are at time step kstp 92 CALL dta_dyn ( istp ) ! Interpolation of the dynamical fields 93 CALL trc_stp ( istp ) ! time-stepping 94 CALL stp_ctl ( istp, indic ) ! Time loop: control and print 83 95 istp = istp + 1 84 96 IF( lk_mpp ) CALL mpp_max( nstop ) 85 97 END DO 86 ! ! ========= ! 87 ! ! Job end!88 ! ! =========!89 90 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA98 99 ! !------------------------! 100 ! !== finalize the run ==! 101 ! !------------------------! 102 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 91 103 92 104 IF( nstop /= 0 .AND. lwp ) THEN ! error print … … 94 106 WRITE(numout,*) nstop, ' error have been found' 95 107 ENDIF 96 108 ! 97 109 CALL opa_closefile 98 110 ! 99 111 IF( lk_mpp ) CALL mppstop ! Close all files (mpp) 100 112 ! … … 106 118 !! *** ROUTINE opa_init *** 107 119 !! 108 !! ** Purpose : opa solves the primitive equations on an orthogonal 109 !! curvilinear mesh on the sphere. 110 !! 111 !! ** Method : - model general initialization 112 !! 113 !! References : 114 !! Madec, Delecluse,Imbard, and Levy, 1997: reference manual. 115 !! internal report, IPSL. 116 !! 117 !! History : 118 !! 4.0 ! 90-10 (C. Levy, G. Madec) Original code 119 !! 7.0 ! 91-11 (M. Imbard, C. Levy, G. Madec) 120 !! 7.1 ! 93-03 (M. Imbard, C. Levy, G. Madec, O. Marti, 121 !! M. Guyon, A. Lazar, P. Delecluse, C. Perigaud, 122 !! G. Caniaux, B. Colot, C. Maes ) release 7.1 123 !! ! 92-06 (L.Terray) coupling implementation 124 !! ! 93-11 (M.A. Filiberti) IGLOO sea-ice 125 !! 8.0 ! 96-03 (M. Imbard, C. Levy, G. Madec, O. Marti, 126 !! M. Guyon, A. Lazar, P. Delecluse, L.Terray, 127 !! M.A. Filiberti, J. Vialar, A.M. Treguier, 128 !! M. Levy) release 8.0 129 !! 8.1 ! 97-06 (M. Imbard, G. Madec) 130 !! 8.2 ! 99-11 (M. Imbard, H. Goosse) LIM sea-ice model 131 !! ! 99-12 (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols) OPEN-MP 132 !! ! 00-07 (J-M Molines, M. Imbard) Open Boundary Conditions (CLIPPER) 133 !! 9.0 ! 02-08 (G. Madec) F90: Free form and modules 134 !!---------------------------------------------------------------------- 135 !! * Local declarations 120 !! ** Purpose : initialization of the opa model in off-line mode 121 !!---------------------------------------------------------------------- 122 INTEGER :: ji ! dummy loop indices 123 INTEGER :: ilocal_comm ! local integer 124 CHARACTER(len=80), DIMENSION(10) :: cltxt = '' 125 !! 126 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 127 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench 128 !!---------------------------------------------------------------------- 129 ! 130 ! ! open Namelist file 131 CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 132 ! 133 READ( numnam, namctl ) ! Namelist namctl : Control prints & Benchmark 134 ! 135 ! !--------------------------------------------! 136 ! ! set communicator & select the local node ! 137 ! !--------------------------------------------! 136 138 #if defined key_iomput 137 INTEGER :: localComm 139 CALL init_ioclient( ilocal_comm ) ! nemo local communicator (used or not) given by the io_server 140 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection 141 #else 142 narea = mynode( cltxt ) ! Nodes selection (control print return in cltxt) 138 143 #endif 139 CHARACTER (len=20) :: namelistname 140 CHARACTER (len=28) :: file_out 141 NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle, & 142 & isplt , jsplt , njctls, njctle, nbench 143 144 !!---------------------------------------------------------------------- 145 146 ! Initializations 147 ! =============== 148 149 file_out = 'ocean.output' 150 151 ! open listing and namelist units 152 CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', & 153 & 'SEQUENTIAL', 1, 6, .FALSE., 1 ) 154 155 namelistname = 'namelist' 156 CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL', & 157 & 1, numout, .FALSE., 1 ) 158 159 WRITE(numout,*) 160 WRITE(numout,*) ' L O D Y C - I P S L' 161 WRITE(numout,*) ' O P A model' 162 WRITE(numout,*) ' Ocean General Circulation Model' 163 WRITE(numout,*) ' version OPA 9.0 (2005) ' 164 WRITE(numout,*) 165 WRITE(numout,*) 166 167 ! Namelist namctl : Control prints & Benchmark 168 REWIND( numnam ) 169 READ ( numnam, namctl ) 170 171 #if defined key_iomput 172 CALL init_ioclient(localcomm) 173 narea = mynode(localComm) 174 #else 175 ! Nodes selection 176 narea = mynode() 144 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 145 146 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 147 148 IF(lwp) THEN ! open listing units 149 ! 150 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 151 ! 152 WRITE(numout,*) 153 WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean' 154 WRITE(numout,*) ' NEMO team' 155 WRITE(numout,*) ' Ocean General Circulation Model' 156 WRITE(numout,*) ' version 3.3 (2010) ' 157 WRITE(numout,*) 158 WRITE(numout,*) 159 DO ji = 1, SIZE(cltxt) 160 IF( TRIM(cltxt(ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode 161 END DO 162 WRITE(numout,cform_aaa) ! Flag AAAAAAA 163 ! 164 ENDIF 165 ! !--------------------------------! 166 ! ! Model general initialization ! 167 ! !--------------------------------! 168 169 CALL opa_ctl ! Control prints & Benchmark 170 171 ! ! Domain decomposition 172 IF( jpni*jpnj == jpnij ) THEN ; CALL mpp_init ! standard cutting out 173 ELSE ; CALL mpp_init2 ! eliminate land processors 174 ENDIF 175 ! 176 ! ! General initialization 177 CALL phy_cst ! Physical constants 178 CALL eos_init ! Equation of state 179 CALL dom_cfg ! Domain configuration 180 CALL dom_init ! Domain 181 CALL istate_init ! ocean initial state (Dynamics and tracers) 182 183 ! ! Ocean physics 184 #if ! defined key_degrad 185 CALL ldf_tra_init ! Lateral ocean tracer physics 177 186 #endif 178 179 ! Nodes selection 180 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 181 lwp = narea == 1 182 183 ! open additionnal listing 184 IF( ln_ctl ) THEN 185 IF( narea-1 > 0 ) THEN 186 WRITE(file_out,FMT="('ocean.output_',I4.4)") narea-1 187 CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', & 188 & 'SEQUENTIAL', 1, numout, .FALSE., 1 ) 189 lwp = .TRUE. 190 ! 191 WRITE(numout,*) 192 WRITE(numout,*) ' L O D Y C - I P S L' 193 WRITE(numout,*) ' O P A model' 194 WRITE(numout,*) ' Ocean General Circulation Model' 195 WRITE(numout,*) ' version OPA 9.0 (2005) ' 196 WRITE(numout,*) ' MPI Ocean output ' 197 WRITE(numout,*) 198 WRITE(numout,*) 199 ENDIF 200 ENDIF 201 202 CALL opa_flg ! Control prints & Benchmark 203 204 ! ! ============================== ! 205 ! ! Model general initialization ! 206 ! ! ============================== ! 187 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 188 189 ! ! Active tracers 190 CALL tra_qsr_init ! penetrative solar radiation qsr 191 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 192 193 ! ! Passive tracers 194 CALL trc_init ! Passive tracers initialization 195 ! ! Dynamics 196 CALL dta_dyn_init ! Initialization for the dynamics 197 CALL iom_init ! iom_put initialization 207 198 208 199 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 209 210 ! Domain decomposition 211 IF( jpni * jpnj == jpnij ) THEN 212 CALL mpp_init ! standard cutting out 213 ELSE 214 CALL mpp_init2 ! eliminate land processors 215 ENDIF 216 217 CALL phy_cst ! Physical constants 218 CALL eos_init ! Equation of state 219 CALL dom_cfg ! Domain configuration 220 CALL dom_init ! Domain 221 CALL istate_init ! ocean initial state (Dynamics and tracers) 222 CALL trc_ini ! Passive tracers 223 CALL dta_dyn( nit000 ) ! Initialization for the dynamics 224 CALL tra_qsr_init ! Solar radiation penetration 225 #if ! defined key_off_degrad 226 CALL ldf_tra_init ! Lateral ocean tracer physics 227 #endif 228 CALL iom_init ! iom_put initialization 229 230 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 231 200 ! 232 201 END SUBROUTINE opa_init 233 202 234 SUBROUTINE opa_flg 235 !!---------------------------------------------------------------------- 236 !! *** ROUTINE opa *** 237 !! 238 !! ** Purpose : Initialize logical flags that control the choice of 239 !! some algorithm or control print 240 !! 241 !! ** Method : Read in namilist namflg logical flags 242 !! 243 !! History : 244 !! 9.0 ! 03-11 (G. Madec) Original code 245 !!---------------------------------------------------------------------- 246 !! * Local declarations 247 248 ! Parameter control and print 249 ! --------------------------- 250 IF(lwp) THEN 203 204 SUBROUTINE opa_ctl 205 !!---------------------------------------------------------------------- 206 !! *** ROUTINE opa_ctl *** 207 !! 208 !! ** Purpose : control print setting 209 !! 210 !! ** Method : - print namctl information and check some consistencies 211 !!---------------------------------------------------------------------- 212 ! 213 IF(lwp) THEN ! Parameter print 251 214 WRITE(numout,*) 252 215 WRITE(numout,*) 'opa_flg: Control prints & Benchmark' 253 216 WRITE(numout,*) '~~~~~~~ ' 254 WRITE(numout,*) ' Namelist namctl' 255 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl 256 WRITE(numout,*) ' level of print nprint = ', nprint 257 WRITE(numout,*) ' Start i indice for SUM control nictls = ', nictls 258 WRITE(numout,*) ' End i indice for SUM control nictle = ', nictle 259 WRITE(numout,*) ' Start j indice for SUM control njctls = ', njctls 260 WRITE(numout,*) ' End j indice for SUM control njctle = ', njctle 261 WRITE(numout,*) ' number of proc. following i isplt = ', isplt 262 WRITE(numout,*) ' number of proc. following j jsplt = ', jsplt 263 WRITE(numout,*) ' benchmark parameter (0/1) nbench = ', nbench 264 ENDIF 265 266 ! ... Control the sub-domain area indices for the control prints 267 IF( ln_ctl ) THEN 268 IF( lk_mpp ) THEN 269 ! the domain is forced to the real splitted domain in MPI 270 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj 217 WRITE(numout,*) ' Namelist namctl' 218 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl 219 WRITE(numout,*) ' level of print nn_print = ', nn_print 220 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls 221 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle 222 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls 223 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle 224 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt 225 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt 226 WRITE(numout,*) ' benchmark parameter (0/1) nn_bench = ', nn_bench 227 ENDIF 228 ! 229 nprint = nn_print ! convert DOCTOR namelist names into OLD names 230 nictls = nn_ictls 231 nictle = nn_ictle 232 njctls = nn_jctls 233 njctle = nn_jctle 234 isplt = nn_isplt 235 jsplt = nn_jsplt 236 nbench = nn_bench 237 ! ! Parameter control 238 ! 239 IF( ln_ctl ) THEN ! sub-domain area indices for the control prints 240 IF( lk_mpp ) THEN 241 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real splitted domain 271 242 ELSE 272 243 IF( isplt == 1 .AND. jsplt == 1 ) THEN 273 CALL ctl_warn( ' - isplt & jsplt are equal to 1', & 274 & ' - the print control will be done over the whole domain' ) 275 ENDIF 276 277 ! compute the total number of processors ijsplt 278 ijsplt = isplt*jsplt 244 CALL ctl_warn( ' - isplt & jsplt are equal to 1', & 245 & ' - the print control will be done over the whole domain' ) 246 ENDIF 247 ijsplt = isplt * jsplt ! total number of processors ijsplt 279 248 ENDIF 280 281 249 IF(lwp) WRITE(numout,*)' - The total number of processors over which the' 282 250 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt 283 284 ! Control the indices used for the SUM control 285 IF( nictls+nictle+njctls+njctle == 0 ) THEN 286 ! the print control is done over the default area 251 ! 252 ! ! indices used for the SUM control 253 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area 287 254 lsp_area = .FALSE. 288 ELSE 289 ! the print control is done over a specific area 255 ELSE ! print control done over a specific area 290 256 lsp_area = .TRUE. 291 257 IF( nictls < 1 .OR. nictls > jpiglo ) THEN … … 293 259 nictls = 1 294 260 ENDIF 295 296 261 IF( nictle < 1 .OR. nictle > jpiglo ) THEN 297 262 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 298 263 nictle = jpiglo 299 264 ENDIF 300 301 265 IF( njctls < 1 .OR. njctls > jpjglo ) THEN 302 266 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 303 267 njctls = 1 304 268 ENDIF 305 306 269 IF( njctle < 1 .OR. njctle > jpjglo ) THEN 307 270 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 308 271 njctle = jpjglo 309 272 ENDIF 310 311 ENDIF ! IF( nictls+nictle+njctls+njctle == 0 ) 312 ENDIF ! IF(ln_ctl) 313 314 IF( nbench == 1 ) THEN 273 ENDIF 274 ENDIF 275 ! 276 IF( nbench == 1 ) THEN ! Benchmark 315 277 SELECT CASE ( cp_cfg ) 316 CASE ( 'gyre' ) 317 CALL ctl_warn( ' The Benchmark is activated ' ) 318 CASE DEFAULT 319 CALL ctl_stop( ' The Benchmark is based on the GYRE configuration: key_gyre must & 320 & be used or set nbench = 0' ) 278 CASE ( 'gyre' ) ; CALL ctl_warn( ' The Benchmark is activated ' ) 279 CASE DEFAULT ; CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:', & 280 & ' key_gyre must be used or set nbench = 0' ) 321 281 END SELECT 322 282 ENDIF 323 324 END SUBROUTINE opa_flg 283 ! 284 IF( lk_c1d .AND. .NOT.lk_iomput ) CALL ctl_stop( 'opa_ctl: The 1D configuration must be used ', & 285 & 'with the IOM Input/Output manager. ' , & 286 & 'Compile with key_iomput enabled' ) 287 ! 288 END SUBROUTINE opa_ctl 289 325 290 326 291 SUBROUTINE opa_closefile … … 329 294 !! 330 295 !! ** Purpose : Close the files 331 !! 332 !! ** Method : 333 !! 334 !! History : 335 !! 9.0 ! 05-01 (O. Le Galloudec) Original code 336 !!---------------------------------------------------------------------- 337 !!---------------------------------------------------------------------- 338 296 !!---------------------------------------------------------------------- 297 ! 339 298 IF ( lk_mpp ) CALL mppsync 340 341 ! 1. Unit close 342 ! ------------- 343 344 CLOSE( numnam ) ! namelist 345 CLOSE( numout ) ! standard model output file 346 347 IF(lwp) CLOSE( numstp ) ! time-step file 348 349 CALL iom_close ! close all input/output files 350 299 ! 300 CALL iom_close ! close all input/output files managed by iom_* 301 ! 302 IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file 303 IF( numnam /= -1 ) CLOSE( numnam ) ! oce namelist 304 IF( numout /= 6 ) CLOSE( numout ) ! standard model output file 305 numout = 6 ! redefine numout in case it is used after this point... 306 ! 351 307 END SUBROUTINE opa_closefile 352 308
Note: See TracChangeset
for help on using the changeset viewer.
