Changeset 1579


Ignore:
Timestamp:
2009-08-05T12:14:11+02:00 (11 years ago)
Author:
smasson
Message:

avoid write in numout before definition of lwp, see ticket:237

Location:
trunk/NEMO/OPA_SRC
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r1528 r1579  
    6666   !!---------------------------------------------------------------------- 
    6767   INTEGER            ::   numstp                 !: logical unit for time step 
    68    INTEGER            ::   numout                 !: logical unit for output print 
     68   INTEGER            ::   numout     =    6      !: logical unit for output print 
    6969   INTEGER            ::   numnam                 !: logical unit for namelist 
    7070   INTEGER            ::   numnam_ice             !: logical unit for ice namelist 
     
    8989   CHARACTER (len=64) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !: 
    9090   CHARACTER (len=64) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !: 
    91    LOGICAL            ::   lwp                      !: boolean : true on the 1st processor only 
     91   LOGICAL            ::   lwp      = .FALSE.       !: boolean : true on the 1st processor only 
    9292   LOGICAL            ::   lsp_area = .TRUE.        !: to make a control print over a specific area 
    9393   !!---------------------------------------------------------------------- 
  • trunk/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r1281 r1579  
    8484      !!-------------------------------------------------------------------- 
    8585 
    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 
    8989      !------------------------------------------------------------------ 
    9090      ! 1st Initialize the PRISM system for the application 
  • trunk/NEMO/OPA_SRC/lib_mpp.F90

    r1559 r1579  
    165165CONTAINS 
    166166 
    167    FUNCTION mynode(localComm) 
     167   FUNCTION mynode(ldtxt, localComm) 
    168168      !!---------------------------------------------------------------------- 
    169169      !!                  ***  routine mynode  *** 
     
    172172      !! 
    173173      !!---------------------------------------------------------------------- 
     174      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt  
     175      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm 
    174176      INTEGER ::   mynode, ierr, code 
    175177      LOGICAL ::   mpi_was_called 
    176       INTEGER, OPTIONAL ::   localComm 
     178       
    177179      NAMELIST/nam_mpp/ c_mpi_send, nn_buffer 
    178180      !!---------------------------------------------------------------------- 
    179181      ! 
    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),*) 
    184186      ! 
    185187      REWIND( numnam )               ! Namelist namrun : parameters of the run 
    186188      READ  ( numnam, nam_mpp ) 
    187189      !                              ! control print 
    188       WRITE(numout,*) '        Namelist nam_mpp' 
    189       WRITE(numout,*) '           mpi send type            c_mpi_send = ', c_mpi_send 
     190      WRITE(ldtxt(5),*) '        Namelist nam_mpp' 
     191      WRITE(ldtxt(6),*) '           mpi send type            c_mpi_send = ', c_mpi_send 
    190192 
    191193#if defined key_agrif 
     
    196198         CALL mpi_initialized ( mpi_was_called, code ) 
    197199         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' 
    199202            CALL mpi_abort( mpi_comm_world, code, ierr ) 
    200203         ENDIF 
     
    204207            SELECT CASE ( c_mpi_send ) 
    205208            CASE ( 'S' )                ! Standard mpi send (blocking) 
    206                WRITE(numout,*) '           Standard blocking mpi send (send)' 
     209               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    207210            CASE ( 'B' )                ! Buffer mpi send (blocking) 
    208                WRITE(numout,*) '           Buffer blocking mpi send (bsend)' 
     211               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    209212               CALL mpi_init_opa( ierr )  
    210213            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)' 
    212215               l_isend = .TRUE. 
    213216            CASE DEFAULT 
    214                WRITE(numout,cform_err) 
    215                WRITE(numout,*) '           bad value for c_mpi_send = ', c_mpi_send 
     217               WRITE(ldtxt(7),cform_err) 
     218               WRITE(ldtxt(8),*) '           bad value for c_mpi_send = ', c_mpi_send 
    216219               nstop = nstop + 1 
    217220            END SELECT 
    218221         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 
    221225         ELSE 
    222226#endif 
    223227            SELECT CASE ( c_mpi_send ) 
    224228            CASE ( 'S' )                ! Standard mpi send (blocking) 
    225                WRITE(numout,*) '           Standard blocking mpi send (send)' 
     229               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    226230               CALL mpi_init( ierr ) 
    227231            CASE ( 'B' )                ! Buffer mpi send (blocking) 
    228                WRITE(numout,*) '           Buffer blocking mpi send (bsend)' 
     232               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    229233               CALL mpi_init_opa( ierr ) 
    230234            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)' 
    232236               l_isend = .TRUE. 
    233237               CALL mpi_init( ierr ) 
    234238            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 
    237242            END SELECT 
    238243 
     
    240245            CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
    241246            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' 
    243249               CALL mpi_abort( mpi_comm_world, code, ierr ) 
    244250            ENDIF 
     
    250256         SELECT CASE ( c_mpi_send ) 
    251257         CASE ( 'S' )                ! Standard mpi send (blocking) 
    252             WRITE(numout,*) '           Standard blocking mpi send (send)' 
     258            WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    253259         CASE ( 'B' )                ! Buffer mpi send (blocking) 
    254             WRITE(numout,*) '           Buffer blocking mpi send (bsend)' 
     260            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    255261         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)' 
    257263            l_isend = .TRUE. 
    258264         CASE DEFAULT 
    259             WRITE(numout,cform_err) 
    260             WRITE(numout,*) '           bad value for c_mpi_send = ', c_mpi_send 
     265            WRITE(ldtxt(7),cform_err) 
     266            WRITE(ldtxt(8),*) '           bad value for c_mpi_send = ', c_mpi_send 
    261267            nstop = nstop + 1 
    262268         END SELECT 
     
    22912297CONTAINS 
    22922298 
    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 
    22952302      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0 
     2303      IF( .FALSE. )   ldtxt(:) = 'never done' 
    22962304   END FUNCTION mynode 
    22972305 
  • trunk/NEMO/OPA_SRC/opa.F90

    r1493 r1579  
    179179      INTEGER :: localComm 
    180180#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 
    183185      NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle,   & 
    184186         &             isplt , jsplt , njctls, njctle, nbench, nbit_cmp 
     
    187189      ! Initializations 
    188190      ! =============== 
    189  
     191      cltxt(:) = '' 
    190192      file_out = 'ocean.output' 
     193      namelistname = 'namelist' 
    191194       
    192       ! open listing and namelist units 
    193       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  
    208195      ! 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... 
    210198      READ  ( numnam, namctl ) 
    211199 
     
    221209# endif 
    222210      ! Nodes selection 
    223       narea = mynode( localComm ) 
     211      narea = mynode( cltxt, localComm ) 
    224212#else 
    225213# if defined key_oasis3 || defined key_oasis4 
     
    227215      CALL cpl_prism_init( localComm ) 
    228216      ! Nodes selection 
    229       narea = mynode( localComm ) 
     217      narea = mynode( cltxt, localComm ) 
    230218# else 
    231219      ! Nodes selection 
    232       narea = mynode() 
     220      narea = mynode( cltxt ) 
    233221# endif 
    234222#endif 
    235223      narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
    236       lwp   = narea == 1 
    237  
    238       ! open additionnal listing 
    239       IF( ln_ctl )  THEN 
    240          IF( narea-1 > 0 )   THEN 
    241             WRITE(file_out,FMT="('ocean.output_',I4.4)") narea-1 
    242             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 
    255243      ENDIF 
    256244 
Note: See TracChangeset for help on using the changeset viewer.