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/SAS/nemogcm.F90

    r11263 r11317  
    151151      ! 
    152152      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    153          WRITE(numout,cform_err) 
    154          WRITE(numout,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    155          WRITE(numout,*) 
     153         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
     154         CALL ctl_stop( ctmp1 ) 
    156155      ENDIF 
    157156      ! 
     
    171170      IF(lwm) THEN 
    172171         IF( nstop == 0 ) THEN   ;   STOP 0 
    173          ELSE                    ;   STOP 999 
     172         ELSE                    ;   STOP 123 
    174173         ENDIF 
    175174      ENDIF 
     
    184183      !! ** Purpose :   initialization of the NEMO GCM 
    185184      !!---------------------------------------------------------------------- 
    186       INTEGER  ::   ji                 ! dummy loop indices 
    187       INTEGER  ::   ios, ilocal_comm   ! local integers 
    188       CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam 
    189       CHARACTER(len=80)                 ::   clname 
     185      INTEGER ::   ios, ilocal_comm   ! local integers 
    190186      !! 
    191187      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   & 
     
    195191      !!---------------------------------------------------------------------- 
    196192      ! 
    197       cltxt  = '' 
    198       cltxt2 = '' 
    199       clnam  = ''   
    200       cxios_context = 'nemo' 
    201       ! 
    202       !                             ! Open reference namelist and configuration namelist files 
    203       IF( lk_oasis ) THEN  
    204          CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    205          CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    206          cxios_context = 'sas' 
    207          clname = 'output.namelist_sas.dyn' 
    208       ELSE 
    209          CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    210          CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    211          cxios_context = 'nemo' 
    212          clname = 'output.namelist.dyn' 
    213    ENDIF 
    214       ! 
    215       REWIND( numnam_ref )              ! Namelist namctl in reference namelist 
    216       READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    217 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    218       REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    219       READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    220 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    221       ! 
    222       REWIND( numnam_ref )              ! Namelist namcfg in reference namelist 
    223       READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    224 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    225       REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist 
    226       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    227 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    228  
    229       !                             !--------------------------! 
    230       !                             !  Set global domain size  !   (control print return in cltxt2) 
    231       !                             !--------------------------! 
    232       IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
    233          CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
    234          ! 
    235       ELSE                                ! user-defined namelist 
    236          CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
    237       ENDIF 
    238       ! 
    239       ! 
    240       !                             !--------------------------------------------! 
    241       !                             !  set communicator & select the local node  ! 
    242       !                             !  NB: mynode also opens output.namelist.dyn ! 
    243       !                             !      on unit number numond on first proc   ! 
    244       !                             !--------------------------------------------! 
     193      IF( lk_oasis ) THEN   ;   cxios_context = 'sas' 
     194      ELSE                  ;   cxios_context = 'nemo' 
     195      ENDIF 
     196      ! 
     197      !                             !-------------------------------------------------! 
     198      !                             !     set communicator & select the local rank    ! 
     199      !                             !  must be done as soon as possible to get narea  ! 
     200      !                             !-------------------------------------------------! 
     201      ! 
    245202#if defined key_iomput 
    246203      IF( Agrif_Root() ) THEN 
    247204         IF( lk_oasis ) THEN 
    248             CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis  
    249             CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios 
     205            CALL cpl_init( "sas", ilocal_comm )                                  ! nemo local communicator given by oasis  
     206            CALL xios_initialize( "not used",local_comm=ilocal_comm )            ! send nemo communicator to xios 
    250207         ELSE 
    251208            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
    252209         ENDIF 
    253210      ENDIF 
    254       narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection 
     211      CALL mpp_start( ilocal_comm ) 
    255212#else 
    256213      IF( lk_oasis ) THEN 
    257214         IF( Agrif_Root() ) THEN 
    258             CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis 
     215            CALL cpl_init( "sas", ilocal_comm )             ! nemo local communicator given by oasis 
    259216         ENDIF 
    260          narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
     217         CALL mpp_start( ilocal_comm ) 
    261218      ELSE 
    262          ilocal_comm = 0 
    263          narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
    264       ENDIF 
    265 #endif 
    266  
    267       narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    268  
    269       IF( sn_cfctl%l_config ) THEN 
    270          ! Activate finer control of report outputs 
    271          ! optionally switch off output from selected areas (note this only 
    272          ! applies to output which does not involve global communications) 
    273          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    274            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    275            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
     219         CALL mpp_start( ) 
     220      ENDIF 
     221#endif 
     222      ! 
     223      narea = mpprank + 1                                   ! mpprank: the rank of proc (0 --> mppsize -1 ) 
     224      lwm = (narea == 1)                ! control of output namelists 
     225      ! 
     226      !                             !---------------------------------------------------------------! 
     227      !                             ! Open output files, reference and configuration namelist files ! 
     228      !                             !---------------------------------------------------------------! 
     229      ! 
     230      ! open ocean.output as soon as possible to get all output prints (including errors messages) 
     231      IF( lk_oasis ) THEN 
     232         IF( lwm )   CALL ctl_opn(     numout,              'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     233         ! open reference and configuration namelist files 
     234                     CALL ctl_opn( numnam_ref,        'namelist_sas_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     235                     CALL ctl_opn( numnam_cfg,        'namelist_sas_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     236         IF( lwm )   CALL ctl_opn(     numond, 'output.namelist_sas.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    276237      ELSE 
    277          ! Use ln_ctl to turn on or off all options. 
    278          CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 
    279       ENDIF 
    280  
    281       lwm = (narea == 1)                                    ! control of output namelists 
    282       lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print 
    283  
    284       IF(lwm) THEN               ! write merged namelists from earlier to output namelist  
    285          !                       ! now that the file has been opened in call to mynode.  
    286          !                       ! NB: nammpp has already been written in mynode (if lk_mpp_mpi) 
    287          WRITE( numond, namctl ) 
    288          WRITE( numond, namcfg ) 
    289          IF( .NOT.ln_read_cfg ) THEN 
    290             DO ji = 1, SIZE(clnam) 
    291                IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print 
    292             END DO 
     238         IF( lwm )   CALL ctl_opn(     numout,            'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     239         ! open reference and configuration namelist files 
     240                     CALL ctl_opn( numnam_ref,            'namelist_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     241                     CALL ctl_opn( numnam_cfg,            'namelist_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     242         IF( lwm )   CALL ctl_opn(     numond,     'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     243      ENDIF 
     244      ! open /dev/null file to be able to supress output write easily 
     245                     CALL ctl_opn(     numnul,               '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     246      ! 
     247      !                             !--------------------! 
     248      !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp 
     249      !                             !--------------------! 
     250      ! 
     251      REWIND( numnam_ref )              ! Namelist namctl in reference namelist 
     252      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
     253901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' ) 
     254      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
     255      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
     256902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' ) 
     257      ! 
     258      lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print 
     259      ! 
     260      IF(lwp) THEN                      ! open listing units 
     261         ! 
     262         IF( .NOT. lwm ) THEN           ! alreay opened for narea == 1 
     263            IF(lk_oasis) THEN   ;   CALL ctl_opn( numout,   'sas.output','REPLACE','FORMATTED','SEQUENTIAL',-1,-1, .FALSE., narea ) 
     264            ELSE                ;   CALL ctl_opn( numout, 'ocean.output','REPLACE','FORMATTED','SEQUENTIAL',-1,-1, .FALSE., narea ) 
     265            ENDIF 
    293266         ENDIF 
    294       ENDIF 
    295  
    296       IF(lwp) THEN                            ! open listing units 
    297          ! 
    298          IF( lk_oasis ) THEN   ;   CALL ctl_opn( numout,   'sas.output', 'REPLACE','FORMATTED','SEQUENTIAL', -1, 6, .FALSE., narea ) 
    299          ELSE                  ;   CALL ctl_opn( numout, 'ocean.output', 'REPLACE','FORMATTED','SEQUENTIAL', -1, 6, .FALSE., narea ) 
    300          ENDIF 
    301267         ! 
    302268         WRITE(numout,*) 
    303          WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC' 
     269         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC' 
    304270         WRITE(numout,*) '                       NEMO team' 
    305271         WRITE(numout,*) '            Ocean General Circulation Model' 
     
    320286         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    321287         WRITE(numout,*) 
    322  
    323          DO ji = 1, SIZE(cltxt) 
    324             IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) TRIM(cltxt(ji))    ! control print of mynode 
    325          END DO 
    326288         WRITE(numout,*) 
    327          WRITE(numout,*) 
    328          DO ji = 1, SIZE(cltxt2) 
    329             IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) TRIM(cltxt2(ji))   ! control print of domain size 
    330          END DO 
    331289         ! 
    332290         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
    333291         ! 
    334292      ENDIF 
    335       ! open /dev/null file to be able to supress output write easily 
    336       CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    337       ! 
    338       !                                      ! Domain decomposition 
    339       CALL mpp_init                          ! MPP 
     293     ! 
     294      ! finalize the definition of namctl variables 
     295      IF( sn_cfctl%l_config ) THEN 
     296         ! Activate finer control of report outputs 
     297         ! optionally switch off output from selected areas (note this only 
     298         ! applies to output which does not involve global communications) 
     299         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
     300           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
     301           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
     302      ELSE 
     303         ! Use ln_ctl to turn on or off all options. 
     304         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 
     305      ENDIF 
     306      ! 
     307      IF(lwm) WRITE( numond, namctl ) 
     308      ! 
     309      !                             !------------------------------------! 
     310      !                             !  Set global domain size parameters ! 
     311      !                             !------------------------------------! 
     312      ! 
     313      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist 
     314      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
     315903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 
     316      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist 
     317      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
     318904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )    
     319      ! 
     320      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
     321         CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     322      ELSE                              ! user-defined namelist 
     323         CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     324      ENDIF 
     325      ! 
     326      IF(lwm)   WRITE( numond, namcfg ) 
     327      ! 
     328      !                             !-----------------------------------------! 
     329      !                             ! mpp parameters and domain decomposition ! 
     330      !                             !-----------------------------------------! 
     331      CALL mpp_init 
    340332 
    341333      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
Note: See TracChangeset for help on using the changeset viewer.