Changeset 1579
- Timestamp:
- 2009-08-05T12:14:11+02:00 (15 years ago)
- Location:
- trunk/NEMO/OPA_SRC
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/IOM/in_out_manager.F90
r1528 r1579 66 66 !!---------------------------------------------------------------------- 67 67 INTEGER :: numstp !: logical unit for time step 68 INTEGER :: numout 68 INTEGER :: numout = 6 !: logical unit for output print 69 69 INTEGER :: numnam !: logical unit for namelist 70 70 INTEGER :: numnam_ice !: logical unit for ice namelist … … 89 89 CHARACTER (len=64) :: cform_err = "(/,' ===>>> : E R R O R', /,' ===========',/)" !: 90 90 CHARACTER (len=64) :: cform_war = "(/,' ===>>> : W A R N I N G', /,' ===============',/)" !: 91 LOGICAL :: lwp 91 LOGICAL :: lwp = .FALSE. !: boolean : true on the 1st processor only 92 92 LOGICAL :: lsp_area = .TRUE. !: to make a control print over a specific area 93 93 !!---------------------------------------------------------------------- -
trunk/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r1281 r1579 84 84 !!-------------------------------------------------------------------- 85 85 86 IF(lwp) WRITE(numout,*) 'cpl_prism_init : initialization in coupled ocean/atmosphere case'87 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'88 IF(lwp) WRITE(numout,*) 86 ! WARNING: No write in numout in this routine 87 !============================================ 88 89 89 !------------------------------------------------------------------ 90 90 ! 1st Initialize the PRISM system for the application -
trunk/NEMO/OPA_SRC/lib_mpp.F90
r1559 r1579 165 165 CONTAINS 166 166 167 FUNCTION mynode(l ocalComm)167 FUNCTION mynode(ldtxt, localComm) 168 168 !!---------------------------------------------------------------------- 169 169 !! *** routine mynode *** … … 172 172 !! 173 173 !!---------------------------------------------------------------------- 174 CHARACTER(len=*),DIMENSION(:), INTENT( out) :: ldtxt 175 INTEGER, OPTIONAL , INTENT(in ) :: localComm 174 176 INTEGER :: mynode, ierr, code 175 177 LOGICAL :: mpi_was_called 176 INTEGER, OPTIONAL :: localComm178 177 179 NAMELIST/nam_mpp/ c_mpi_send, nn_buffer 178 180 !!---------------------------------------------------------------------- 179 181 ! 180 WRITE( numout,*)181 WRITE( numout,*) 'mynode : mpi initialisation'182 WRITE( numout,*) '~~~~~~ '183 WRITE( numout,*)182 WRITE(ldtxt(1),*) 183 WRITE(ldtxt(2),*) 'mynode : mpi initialisation' 184 WRITE(ldtxt(3),*) '~~~~~~ ' 185 WRITE(ldtxt(4),*) 184 186 ! 185 187 REWIND( numnam ) ! Namelist namrun : parameters of the run 186 188 READ ( numnam, nam_mpp ) 187 189 ! ! control print 188 WRITE( numout,*) ' Namelist nam_mpp'189 WRITE( numout,*) ' mpi send type c_mpi_send = ', c_mpi_send190 WRITE(ldtxt(5),*) ' Namelist nam_mpp' 191 WRITE(ldtxt(6),*) ' mpi send type c_mpi_send = ', c_mpi_send 190 192 191 193 #if defined key_agrif … … 196 198 CALL mpi_initialized ( mpi_was_called, code ) 197 199 IF( code /= MPI_SUCCESS ) THEN 198 CALL ctl_stop( ' lib_mpp: Error in routine mpi_initialized' ) 200 WRITE(*, cform_err) 201 WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 199 202 CALL mpi_abort( mpi_comm_world, code, ierr ) 200 203 ENDIF … … 204 207 SELECT CASE ( c_mpi_send ) 205 208 CASE ( 'S' ) ! Standard mpi send (blocking) 206 WRITE( numout,*) ' Standard blocking mpi send (send)'209 WRITE(ldtxt(7),*) ' Standard blocking mpi send (send)' 207 210 CASE ( 'B' ) ! Buffer mpi send (blocking) 208 WRITE( numout,*) ' Buffer blocking mpi send (bsend)'211 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 209 212 CALL mpi_init_opa( ierr ) 210 213 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 211 WRITE( numout,*) ' Immediate non-blocking send (isend)'214 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' 212 215 l_isend = .TRUE. 213 216 CASE DEFAULT 214 WRITE( numout,cform_err)215 WRITE( numout,*) ' bad value for c_mpi_send = ', c_mpi_send217 WRITE(ldtxt(7),cform_err) 218 WRITE(ldtxt(8),*) ' bad value for c_mpi_send = ', c_mpi_send 216 219 nstop = nstop + 1 217 220 END SELECT 218 221 ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 219 WRITE(numout,*) ' lib_mpp: You cannot provide a local communicator ' 220 WRITE(numout,*) ' without calling MPI_Init before ! ' 222 WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 223 WRITE(ldtxt(8),*) ' without calling MPI_Init before ! ' 224 nstop = nstop + 1 221 225 ELSE 222 226 #endif 223 227 SELECT CASE ( c_mpi_send ) 224 228 CASE ( 'S' ) ! Standard mpi send (blocking) 225 WRITE( numout,*) ' Standard blocking mpi send (send)'229 WRITE(ldtxt(7),*) ' Standard blocking mpi send (send)' 226 230 CALL mpi_init( ierr ) 227 231 CASE ( 'B' ) ! Buffer mpi send (blocking) 228 WRITE( numout,*) ' Buffer blocking mpi send (bsend)'232 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 229 233 CALL mpi_init_opa( ierr ) 230 234 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 231 WRITE( numout,*) ' Immediate non-blocking send (isend)'235 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' 232 236 l_isend = .TRUE. 233 237 CALL mpi_init( ierr ) 234 238 CASE DEFAULT 235 WRITE(ctmp1,*) ' bad value for c_mpi_send = ', c_mpi_send 236 CALL ctl_stop( ctmp1 ) 239 WRITE(ldtxt(7),cform_err) 240 WRITE(ldtxt(8),*) ' bad value for c_mpi_send = ', c_mpi_send 241 nstop = nstop + 1 237 242 END SELECT 238 243 … … 240 245 CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 241 246 IF( code /= MPI_SUCCESS ) THEN 242 CALL ctl_stop( ' lib_mpp: Error in routine mpi_comm_dup' ) 247 WRITE(*, cform_err) 248 WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 243 249 CALL mpi_abort( mpi_comm_world, code, ierr ) 244 250 ENDIF … … 250 256 SELECT CASE ( c_mpi_send ) 251 257 CASE ( 'S' ) ! Standard mpi send (blocking) 252 WRITE( numout,*) ' Standard blocking mpi send (send)'258 WRITE(ldtxt(7),*) ' Standard blocking mpi send (send)' 253 259 CASE ( 'B' ) ! Buffer mpi send (blocking) 254 WRITE( numout,*) ' Buffer blocking mpi send (bsend)'260 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 255 261 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 256 WRITE( numout,*) ' Immediate non-blocking send (isend)'262 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' 257 263 l_isend = .TRUE. 258 264 CASE DEFAULT 259 WRITE( numout,cform_err)260 WRITE( numout,*) ' bad value for c_mpi_send = ', c_mpi_send265 WRITE(ldtxt(7),cform_err) 266 WRITE(ldtxt(8),*) ' bad value for c_mpi_send = ', c_mpi_send 261 267 nstop = nstop + 1 262 268 END SELECT … … 2291 2297 CONTAINS 2292 2298 2293 FUNCTION mynode( localComm ) RESULT (function_value) 2294 INTEGER, OPTIONAL :: localComm 2299 FUNCTION mynode( ldtxt, localComm ) RESULT (function_value) 2300 CHARACTER(len=*),DIMENSION(:), INTENT( out) :: ldtxt 2301 INTEGER, OPTIONAL , INTENT(in ) :: localComm 2295 2302 IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) ) function_value = 0 2303 IF( .FALSE. ) ldtxt(:) = 'never done' 2296 2304 END FUNCTION mynode 2297 2305 -
trunk/NEMO/OPA_SRC/opa.F90
r1493 r1579 179 179 INTEGER :: localComm 180 180 #endif 181 CHARACTER (len=20) :: namelistname 182 CHARACTER (len=28) :: file_out 181 CHARACTER(len=20) :: namelistname 182 CHARACTER(len=28) :: file_out 183 CHARACTER(len=80),dimension(10) :: cltxt 184 INTEGER :: ji ! local loop indicees 183 185 NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle, & 184 186 & isplt , jsplt , njctls, njctle, nbench, nbit_cmp … … 187 189 ! Initializations 188 190 ! =============== 189 191 cltxt(:) = '' 190 192 file_out = 'ocean.output' 193 namelistname = 'namelist' 191 194 192 ! open listing and namelist units193 CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', &194 & 'SEQUENTIAL', 1, 6, .FALSE., 1 )195 196 WRITE(numout,*)197 WRITE(numout,*) ' L O D Y C - I P S L'198 WRITE(numout,*) ' O P A model'199 WRITE(numout,*) ' Ocean General Circulation Model'200 WRITE(numout,*) ' version OPA 9.0 (2005) '201 WRITE(numout,*)202 WRITE(numout,*)203 204 namelistname = 'namelist'205 CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL', &206 & 1, numout, .FALSE., 1 )207 208 195 ! Namelist namctl : Control prints & Benchmark 209 REWIND( numnam ) 196 CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., 1 ) 197 REWIND( numnam ) ! is this really needed? we just open the file... 210 198 READ ( numnam, namctl ) 211 199 … … 221 209 # endif 222 210 ! Nodes selection 223 narea = mynode( localComm )211 narea = mynode( cltxt, localComm ) 224 212 #else 225 213 # if defined key_oasis3 || defined key_oasis4 … … 227 215 CALL cpl_prism_init( localComm ) 228 216 ! Nodes selection 229 narea = mynode( localComm )217 narea = mynode( cltxt, localComm ) 230 218 # else 231 219 ! Nodes selection 232 narea = mynode( )220 narea = mynode( cltxt ) 233 221 # endif 234 222 #endif 235 223 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 236 lwp = narea == 1 237 238 ! open additionnal listing 239 IF( l n_ctl )THEN240 IF( narea-1 > 0 ) THEN241 WRITE(file_out,FMT="('ocean.output_',I4.4)")narea-1242 CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', &243 & 'SEQUENTIAL', 1, numout, .FALSE., 1 )244 lwp = .TRUE.245 !246 WRITE(numout,*)247 WRITE(numout,*) ' L O D Y C - I P S L'248 WRITE(numout,*) ' O P A model'249 WRITE(numout,*) ' Ocean General Circulation Model'250 WRITE(numout,*) ' version OPA 9.0 (2005) '251 WRITE(numout,*) ' MPI Ocean output '252 WRITE(numout,*)253 WRITE(numout,*)254 ENDIF 224 225 lwp = narea == 1 .OR. ln_ctl ! print control 226 227 IF( lwp ) THEN 228 ! open listing and namelist units 229 IF( narea > 1 ) WRITE(file_out, "(a,'_',i4.4)") TRIM(file_out), narea-1 230 CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., 1 ) 231 232 WRITE(numout,*) 233 WRITE(numout,*) ' L O D Y C - I P S L' 234 WRITE(numout,*) ' O P A model' 235 WRITE(numout,*) ' Ocean General Circulation Model' 236 WRITE(numout,*) ' version OPA 9.0 (2005) ' 237 WRITE(numout,*) 238 WRITE(numout,*) 239 DO ji = 1, SIZE(cltxt) 240 IF (TRIM(cltxt(ji)) /= '') WRITE(numout,*) cltxt(ji) 241 END DO 242 255 243 ENDIF 256 244
Note: See TracChangeset
for help on using the changeset viewer.