Ignore:
Timestamp:
2019-07-22T10:32:59+02:00 (15 months ago)
Author:
smasson
Message:

dev_r10984_HPC-13 : improve error handling, see #2307 and #2285

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/nemogcm.F90

    r10588 r11317  
    103103 
    104104#if defined key_mpp_mpi 
     105   ! need MPI_Wtime 
    105106   INCLUDE 'mpif.h' 
    106107#endif 
     
    220221      ! 
    221222      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    222          WRITE(numout,cform_err) 
    223          WRITE(numout,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    224          WRITE(numout,*) 
     223         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
     224         CALL ctl_stop( ctmp1 ) 
    225225      ENDIF 
    226226      ! 
     
    240240      IF(lwm) THEN 
    241241         IF( nstop == 0 ) THEN   ;   STOP 0 
    242          ELSE                    ;   STOP 999 
     242         ELSE                    ;   STOP 123 
    243243         ENDIF 
    244244      ENDIF 
     
    253253      !! ** Purpose :   initialization of the NEMO GCM 
    254254      !!---------------------------------------------------------------------- 
    255       INTEGER  ::   ji                 ! dummy loop indices 
    256       INTEGER  ::   ios, ilocal_comm   ! local integers 
    257       CHARACTER(len=120), DIMENSION(60) ::   cltxt, cltxt2, clnam 
     255      INTEGER ::   ios, ilocal_comm   ! local integers 
    258256      !! 
    259257      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   & 
     
    263261      !!---------------------------------------------------------------------- 
    264262      ! 
    265       cltxt  = '' 
    266       cltxt2 = '' 
    267       clnam  = ''   
    268263      cxios_context = 'nemo' 
    269264      ! 
    270       !                             ! Open reference namelist and configuration namelist files 
    271       CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    272       CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    273       ! 
    274       REWIND( numnam_ref )              ! Namelist namctl in reference namelist 
    275       READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    276 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    277       REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    278       READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    279 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    280       ! 
    281       REWIND( numnam_ref )              ! Namelist namcfg in reference namelist 
    282       READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    283 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    284       REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist 
    285       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    286 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    287  
    288       !                             !--------------------------! 
    289       !                             !  Set global domain size  !   (control print return in cltxt2) 
    290       !                             !--------------------------! 
    291       IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
    292          CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
    293          ! 
    294       ELSE                                ! user-defined namelist 
    295          CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
    296       ENDIF 
    297       ! 
    298       ! 
    299       !                             !--------------------------------------------! 
    300       !                             !  set communicator & select the local node  ! 
    301       !                             !  NB: mynode also opens output.namelist.dyn ! 
    302       !                             !      on unit number numond on first proc   ! 
    303       !                             !--------------------------------------------! 
     265      !                             !-------------------------------------------------! 
     266      !                             !     set communicator & select the local rank    ! 
     267      !                             !  must be done as soon as possible to get narea  ! 
     268      !                             !-------------------------------------------------! 
     269      ! 
    304270#if defined key_iomput 
    305271      IF( Agrif_Root() ) THEN 
    306272         IF( lk_oasis ) THEN 
    307273            CALL cpl_init( "oceanx", ilocal_comm )                               ! nemo local communicator given by oasis 
    308             CALL xios_initialize( "not used"       ,local_comm= ilocal_comm )    ! send nemo communicator to xios 
     274            CALL xios_initialize( "not used"       , local_comm =ilocal_comm )   ! send nemo communicator to xios 
    309275         ELSE 
    310             CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
     276            CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios 
    311277         ENDIF 
    312278      ENDIF 
    313       ! Nodes selection (control print return in cltxt) 
    314       narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 
     279      CALL mpp_start( ilocal_comm ) 
    315280#else 
    316281      IF( lk_oasis ) THEN 
     
    318283            CALL cpl_init( "oceanx", ilocal_comm )          ! nemo local communicator given by oasis 
    319284         ENDIF 
    320          ! Nodes selection (control print return in cltxt) 
    321          narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 
     285         CALL mpp_start( ilocal_comm ) 
    322286      ELSE 
    323          ilocal_comm = 0                                    ! Nodes selection (control print return in cltxt) 
    324          narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 
    325       ENDIF 
    326 #endif 
    327  
    328       narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    329  
    330       IF( sn_cfctl%l_config ) THEN 
    331          ! Activate finer control of report outputs 
    332          ! optionally switch off output from selected areas (note this only 
    333          ! applies to output which does not involve global communications) 
    334          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    335            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    336            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    337       ELSE 
    338          ! Use ln_ctl to turn on or off all options. 
    339          CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 
    340       ENDIF 
    341  
    342       lwm = (narea == 1)                                    ! control of output namelists 
    343       lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print 
    344  
    345       IF(lwm) THEN               ! write merged namelists from earlier to output namelist  
    346          !                       ! now that the file has been opened in call to mynode.  
    347          !                       ! NB: nammpp has already been written in mynode (if lk_mpp_mpi) 
    348          WRITE( numond, namctl ) 
    349          WRITE( numond, namcfg ) 
    350          IF( .NOT.ln_read_cfg ) THEN 
    351             DO ji = 1, SIZE(clnam) 
    352                IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print 
    353             END DO 
    354          ENDIF 
    355       ENDIF 
    356  
    357       IF(lwp) THEN                            ! open listing units 
    358          ! 
    359          CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     287         CALL mpp_start( ) 
     288      ENDIF 
     289#endif 
     290      ! 
     291      narea = mpprank + 1               ! mpprank: the rank of proc (0 --> mppsize -1 ) 
     292      lwm = (narea == 1)                ! control of output namelists 
     293      ! 
     294      !                             !---------------------------------------------------------------! 
     295      !                             ! Open output files, reference and configuration namelist files ! 
     296      !                             !---------------------------------------------------------------! 
     297      ! 
     298      ! open ocean.output as soon as possible to get all output prints (including errors messages) 
     299      IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     300      ! open reference and configuration namelist files 
     301                  CALL ctl_opn( numnam_ref,        'namelist_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     302                  CALL ctl_opn( numnam_cfg,        'namelist_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     303      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     304      ! open /dev/null file to be able to supress output write easily 
     305                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     306      ! 
     307      !                             !--------------------! 
     308      !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp 
     309      !                             !--------------------! 
     310      ! 
     311      REWIND( numnam_ref )              ! Namelist namctl in reference namelist 
     312      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
     313901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' ) 
     314      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
     315      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
     316902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' ) 
     317      ! 
     318      lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print 
     319      ! 
     320      IF(lwp) THEN                      ! open listing units 
     321         ! 
     322         IF( .NOT. lwm )   &            ! alreay opened for narea == 1 
     323            &            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 
    360324         ! 
    361325         WRITE(numout,*) 
    362          WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC' 
     326         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC' 
    363327         WRITE(numout,*) '                       NEMO team' 
    364328         WRITE(numout,*) '            Ocean General Circulation Model' 
     
    379343         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    380344         WRITE(numout,*) 
    381           
    382          DO ji = 1, SIZE(cltxt) 
    383             IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) TRIM(cltxt(ji))    ! control print of mynode 
    384          END DO 
    385          WRITE(numout,*) 
    386          WRITE(numout,*) 
    387          DO ji = 1, SIZE(cltxt2) 
    388             IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) TRIM(cltxt2(ji))   ! control print of domain size 
    389          END DO 
    390345         ! 
    391346         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
    392347         ! 
    393348      ENDIF 
    394       ! open /dev/null file to be able to supress output write easily 
    395       CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    396       ! 
    397       !                                      ! Domain decomposition 
    398       CALL mpp_init                          ! MPP 
     349      ! 
     350      ! finalize the definition of namctl variables 
     351      IF( sn_cfctl%l_config ) THEN 
     352         ! Activate finer control of report outputs 
     353         ! optionally switch off output from selected areas (note this only 
     354         ! applies to output which does not involve global communications) 
     355         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
     356           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
     357           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
     358      ELSE 
     359         ! Use ln_ctl to turn on or off all options. 
     360         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 
     361      ENDIF 
     362      ! 
     363      IF(lwm) WRITE( numond, namctl ) 
     364      ! 
     365      !                             !------------------------------------! 
     366      !                             !  Set global domain size parameters ! 
     367      !                             !------------------------------------! 
     368      ! 
     369      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist 
     370      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
     371903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 
     372      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist 
     373      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
     374904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )    
     375      ! 
     376      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
     377         CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     378      ELSE                              ! user-defined namelist 
     379         CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     380      ENDIF 
     381      ! 
     382      IF(lwm)   WRITE( numond, namcfg ) 
     383      ! 
     384      !                             !-----------------------------------------! 
     385      !                             ! mpp parameters and domain decomposition ! 
     386      !                             !-----------------------------------------! 
     387      CALL mpp_init 
    399388 
    400389      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
     
    507496      !! ** Purpose :   control print setting 
    508497      !! 
    509       !! ** Method  : - print namctl information and check some consistencies 
     498      !! ** Method  : - print namctl and namcfg information and check some consistencies 
    510499      !!---------------------------------------------------------------------- 
    511500      ! 
     
    673662   END SUBROUTINE nemo_alloc 
    674663 
     664    
    675665   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
    676666      !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.