Ignore:
Timestamp:
2019-07-22T10:32:59+02:00 (14 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/SAO/nemogcm.F90

    r10601 r11317  
    8989      !! ** Purpose :   initialization of the NEMO GCM 
    9090      !!---------------------------------------------------------------------- 
    91       INTEGER ::   ji                 ! dummy loop indices 
    9291      INTEGER ::   ios, ilocal_comm   ! local integer 
    93       CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam 
    9492      ! 
    9593      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   & 
     
    9997      !!---------------------------------------------------------------------- 
    10098      ! 
    101       cltxt  = '' 
    102       cltxt2 = '' 
    103       clnam  = ''   
    10499      cxios_context = 'nemo' 
    105100      ! 
    106       !                             ! Open reference namelist and configuration namelist files 
    107       CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    108       CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    109       ! 
    110       REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints 
    111       READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    112 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    113       REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    114       READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    115 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    116       ! 
    117       REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints 
    118       READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    119 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    120       REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark 
    121       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    122 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    123  
    124       !                             !--------------------------! 
    125       !                             !  Set global domain size  !   (control print return in cltxt2) 
    126       !                             !--------------------------! 
    127       IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
    128          CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
    129          ! 
    130       ELSE                                ! user-defined namelist 
    131          CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
    132       ENDIF 
    133       ! 
    134       ! 
    135       !                             !--------------------------------------------! 
    136       !                             !  set communicator & select the local node  ! 
    137       !                             !  NB: mynode also opens output.namelist.dyn ! 
    138       !                             !      on unit number numond on first proc   ! 
    139       !                             !--------------------------------------------! 
     101      !                             !-------------------------------------------------! 
     102      !                             !     set communicator & select the local rank    ! 
     103      !                             !  must be done as soon as possible to get narea  ! 
     104      !                             !-------------------------------------------------! 
     105      ! 
    140106#if defined key_iomput 
    141107      IF( Agrif_Root() ) THEN 
    142108         IF( lk_oasis ) THEN 
    143             CALL cpl_init( "oceanx", ilocal_comm )                     ! nemo local communicator given by oasis 
    144             CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios 
     109            CALL cpl_init( "oceanx", ilocal_comm )                               ! nemo local communicator given by oasis 
     110            CALL xios_initialize( "not used"       , local_comm =ilocal_comm )   ! send nemo communicator to xios 
    145111         ELSE 
    146             CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
     112            CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios 
    147113         ENDIF 
    148114      ENDIF 
    149       ! Nodes selection (control print return in cltxt) 
    150       narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 
     115      CALL mpp_start( ilocal_comm ) 
    151116#else 
    152117      IF( lk_oasis ) THEN 
    153118         IF( Agrif_Root() ) THEN 
    154             CALL cpl_init( "oceanx", ilocal_comm )                      ! nemo local communicator given by oasis 
     119            CALL cpl_init( "oceanx", ilocal_comm )          ! nemo local communicator given by oasis 
    155120         ENDIF 
    156          ! Nodes selection (control print return in cltxt) 
    157          narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 
     121         CALL mpp_start( ilocal_comm ) 
    158122      ELSE 
    159          ilocal_comm = 0                                    ! Nodes selection (control print return in cltxt) 
    160          narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 
     123         CALL mpp_start( ) 
    161124      ENDIF 
    162125#endif 
    163  
    164       narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    165  
    166       IF( sn_cfctl%l_config ) THEN 
    167          ! Activate finer control of report outputs 
    168          ! optionally switch off output from selected areas (note this only 
    169          ! applies to output which does not involve global communications 
    170          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    171            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    172            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    173       ELSE 
    174          ! Use ln_ctl to turn on or off all options. 
    175          CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 
    176       ENDIF 
    177  
    178       lwm = (narea == 1)                                    ! control of output namelists 
    179       lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print 
    180  
    181       IF(lwm) THEN 
    182          ! write merged namelists from earlier to output namelist now that the 
    183          ! file has been opened in call to mynode. nammpp has already been 
    184          ! written in mynode (if lk_mpp_mpi) 
    185          WRITE( numond, namctl ) 
    186          WRITE( numond, namcfg ) 
    187          IF( .NOT.ln_read_cfg ) THEN 
    188             DO ji = 1, SIZE(clnam) 
    189                IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print 
    190             END DO 
    191          ENDIF 
    192       ENDIF 
    193  
    194       IF(lwp) THEN                            ! open listing units 
    195          ! 
    196          CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
    197          ! 
    198          WRITE(numout,*) 
    199          WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC' 
     126      ! 
     127      narea = mpprank + 1               ! mpprank: the rank of proc (0 --> mppsize -1 ) 
     128      lwm = (narea == 1)                ! control of output namelists 
     129      ! 
     130      !                             !---------------------------------------------------------------! 
     131      !                             ! Open output files, reference and configuration namelist files ! 
     132      !                             !---------------------------------------------------------------! 
     133      ! 
     134      ! open ocean.output as soon as possible to get all output prints (including errors messages) 
     135      IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     136      ! open reference and configuration namelist files 
     137                  CALL ctl_opn( numnam_ref,        'namelist_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     138                  CALL ctl_opn( numnam_cfg,        'namelist_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     139      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     140      ! open /dev/null file to be able to supress output write easily 
     141                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     142      ! 
     143      !                             !--------------------! 
     144      !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp 
     145      !                             !--------------------! 
     146      ! 
     147      REWIND( numnam_ref )              ! Namelist namctl in reference namelist 
     148      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
     149901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' ) 
     150      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
     151      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
     152902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' ) 
     153      ! 
     154      lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print 
     155      ! 
     156      IF(lwp) THEN                      ! open listing units 
     157         ! 
     158         IF( .NOT. lwm )   &            ! alreay opened for narea == 1 
     159            &            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 
     160         ! 
     161         WRITE(numout,*) 
     162         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC' 
    200163         WRITE(numout,*) '                       NEMO team' 
    201164         WRITE(numout,*) '            Stand Alone Observation operator' 
     
    213176         WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   " 
    214177         WRITE(numout,*) "      (  (           \_/       '-._\      )   )  " 
    215          WRITE(numout,*) "       )  )                        `     (   (   " 
     178         WRITE(numout,*) "       )  ) jgs                     `    (   (   " 
    216179         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    217180         WRITE(numout,*) 
    218          DO ji = 1, SIZE(cltxt) 
    219             IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) TRIM(cltxt(ji))    ! control print of mynode 
    220          END DO 
    221          WRITE(numout,*) 
    222          WRITE(numout,*) 
    223          DO ji = 1, SIZE(cltxt2) 
    224             IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) TRIM(cltxt2(ji))   ! control print of domain size 
    225          END DO 
    226181         ! 
    227182         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
    228183         ! 
    229184      ENDIF 
    230       !                                      ! Domain decomposition 
    231       CALL mpp_init                          ! MPP 
     185      ! 
     186      ! finalize the definition of namctl variables 
     187      IF( sn_cfctl%l_config ) THEN 
     188         ! Activate finer control of report outputs 
     189         ! optionally switch off output from selected areas (note this only 
     190         ! applies to output which does not involve global communications) 
     191         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
     192           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
     193           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
     194      ELSE 
     195         ! Use ln_ctl to turn on or off all options. 
     196         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 
     197      ENDIF 
     198      ! 
     199      IF(lwm) WRITE( numond, namctl ) 
     200      ! 
     201      !                             !------------------------------------! 
     202      !                             !  Set global domain size parameters ! 
     203      !                             !------------------------------------! 
     204      ! 
     205      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist 
     206      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
     207903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 
     208      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist 
     209      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
     210904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )    
     211      ! 
     212      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
     213         CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     214      ELSE                              ! user-defined namelist 
     215         CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     216      ENDIF 
     217      ! 
     218      IF(lwm)   WRITE( numond, namcfg ) 
     219      ! 
     220      !                             !-----------------------------------------! 
     221      !                             ! mpp parameters and domain decomposition ! 
     222      !                             !-----------------------------------------! 
     223      CALL mpp_init 
    232224 
    233225      ! 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.