Changeset 11348


Ignore:
Timestamp:
2019-07-25T14:02:55+02:00 (13 months ago)
Author:
gsamson
Message:

dev_r11265_ABL :

  • merge HPC-13_IRRMANN_BDY_optimization branch @ rev11332 with dev_r11265_ABL branch @ rev11334
  • allow ln_dm2dc option with ABL
  • cosmetic change in sbcabl.F90

identical results with rev11334 for bulk and abl orca2

Location:
NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src
Files:
137 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ABL/ablmod.F90

    r11334 r11348  
    9292      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssq_ice     ! ice-surface humidity  
    9393      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pcd_du_ice   ! Cd x Du over ice (T-point) 
    94      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   psen_ice     ! Ch x Du over ice (T-point) 
    95      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pevp_ice     ! Ce x Du over ice (T-point) 
    96      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndm_ice    ! ||uwnd - uice||   
    97      REAL(wp) , INTENT(inout), DIMENSION(:,:  ) ::   pfrac_oce    ! 
     94      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   psen_ice     ! Ch x Du over ice (T-point) 
     95      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pevp_ice     ! Ce x Du over ice (T-point) 
     96      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndm_ice    ! ||uwnd - uice||   
     97      !REAL(wp) , INTENT(inout), DIMENSION(:,:  ) ::   pfrac_oce     !!GS: out useless ? 
     98      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pfrac_oce      ! 
    9899      REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptaui_ice    ! ice-surface taux stress (U-point) 
    99100      REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptauj_ice    ! ice-surface tauy stress (V-point)      
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ABL/sbcabl.F90

    r11334 r11348  
    7676      REWIND( numnam_ref )              ! Namelist namsbc_abl in reference namelist : ABL parameters 
    7777      READ  ( numnam_ref, namsbc_abl, IOSTAT = ios, ERR = 901 ) 
    78 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in reference namelist', lwp ) 
     78901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in reference namelist' ) 
    7979      ! 
    8080      REWIND( numnam_cfg )              ! Namelist namsbc_abl in configuration namelist : ABL parameters 
    8181      READ  ( numnam_cfg, namsbc_abl, IOSTAT = ios, ERR = 902 ) 
    82 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in configuration namelist', lwp ) 
     82902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in configuration namelist' ) 
    8383      ! 
    8484      IF(lwm) WRITE( numond, namsbc_abl ) 
     
    147147      CALL iom_get( inum, jpdom_unknown, 'ghw_abl', ghw_abl(:) ) 
    148148      CALL iom_close( inum ) 
    149       
     149 
    150150#if ! defined key_iomput 
    151151     IF( dia_wri_alloc_abl()  /= 0 ) CALL ctl_stop( 'STOP', 'abl_init : unable to allocate arrays' ) 
     
    328328      !! 2 - Compute Cd x ||U||, Ch x ||U||, Ce x ||U||, and SSQ using now fields 
    329329      !!-------------------------------------------------------------------------------------------   
    330           
    331       CALL blk_oce_1( kt, u_abl(:,:,2,nt_n), v_abl(:,:,2,nt_n), tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),             & 
    332               &           sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m, & 
    333               &              zssq, zcd_du, zsen, zevp ) 
    334  
     330 
     331      CALL blk_oce_1( kt,  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),   &   !   <<= in 
     332         &                tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in 
     333         &                sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m     ,   &   !   <<= in 
     334         &                zssq, zcd_du, zsen, zevp                          )       !   =>> out 
     335   
    335336#if defined key_si3 
    336      CALL blk_ice_1( u_abl(:,:,2,nt_n), v_abl(:,:,2,nt_n), tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   & 
    337         &            sf(jp_slp)%fnow(:,:,1), u_ice, v_ice,                                          & 
    338          &            pseni=zseni, pevpi=zevpi, ptsui=tm_su, pssqi=zssqi, pcd_dui=zcd_dui )   ! outputs   
     337      CALL blk_ice_1(  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),   &   !   <<= in 
     338         &            tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in 
     339         &            sf(jp_slp)%fnow(:,:,1)  ,  u_ice, v_ice           ,   &   !   <<= in 
     340         &            pseni=zseni, pevpi=zevpi, ptsui=tm_su             ,   &   !   <<= out 
     341         &            pssqi=zssqi, pcd_dui=zcd_dui                      )       !   =>> out 
    339342#endif   
    340343 
     
    343346      !!-------------------------------------------------------------------------------------------     
    344347   
    345       CALL abl_stp( kt, sst_m, ssu_m, ssv_m, zssq, &                            ! in 
    346               &         sf(jp_wndi)%fnow(:,:,:), sf(jp_wndj)%fnow(:,:,:),   & 
    347               &         sf(jp_tair)%fnow(:,:,:), sf(jp_humi)%fnow(:,:,:), sf(jp_slp)%fnow(:,:,1),  & 
    348               &         sf(jp_hpgi)%fnow(:,:,:), sf(jp_hpgj)%fnow(:,:,:),                          & 
    349               &         zcd_du, zsen, zevp,    &                                ! in/out 
    350               &         wndm, utau, vtau, taum &                                 ! out 
     348      CALL abl_stp( kt, sst_m, ssu_m, ssv_m, zssq,                          &   !   <<= in 
     349         &              sf(jp_wndi)%fnow(:,:,:), sf(jp_wndj)%fnow(:,:,:),   &   !   <<= in 
     350         &              sf(jp_tair)%fnow(:,:,:), sf(jp_humi)%fnow(:,:,:),   &   !   <<= in 
     351         &              sf(jp_slp )%fnow(:,:,1),                            &   !   <<= in 
     352         &              sf(jp_hpgi)%fnow(:,:,:), sf(jp_hpgj)%fnow(:,:,:),   &   !   <<= in 
     353         &              zcd_du, zsen, zevp,                                 &   !   <=> in/out 
     354         &              wndm, utau, vtau, taum                              &   !   =>> out 
    351355#if defined key_si3           
    352               &          , tm_su, u_ice, v_ice, zssqi, zcd_dui   &  
    353               &          , zseni, zevpi, wndm_ice, ato_i,        &  
    354            &            utau_ice,     vtau_ice                & 
     356         &            , tm_su, u_ice, v_ice, zssqi, zcd_dui                 &   !   <<= in 
     357         &            , zseni, zevpi, wndm_ice, ato_i                       &   !   <<= in 
     358         &            , utau_ice, vtau_ice                                  &   !   =>> out 
    355359#endif            
    356               &                                                                ) 
     360                                                                         ) 
    357361      !!------------------------------------------------------------------------------------------- 
    358362      !! 4 - Finalize flux computation using ABL variables at (n+1), nt_n corresponds to (n+1) since  
     
    360364      !!-------------------------------------------------------------------------------------------    
    361365 
    362       CALL blk_oce_2( kt, tq_abl(:,:,2,nt_n,jp_ta), sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1),     & 
    363               &           sf(jp_prec)%fnow(:,:,1),  sf(jp_snow)%fnow(:,:,1),   & 
    364               &           sst_m , zsen, zevp ) 
     366      CALL blk_oce_2( kt, tq_abl(:,:,2,nt_n,jp_ta),                            & 
     367         &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1),   & 
     368         &                sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1),   & 
     369         &                sst_m, zsen, zevp                                ) 
    365370 
    366371#if defined key_si3 
    367 ! Avoid a USE abl in icesbc module 
     372      ! Avoid a USE abl in icesbc module 
    368373      sf(jp_tair)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_ta);  sf(jp_humi)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_qa) 
    369374#endif  
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icealb.F90

    r10535 r11348  
    192192      REWIND( numnam_ice_ref )              ! Namelist namalb in reference namelist : Albedo parameters 
    193193      READ  ( numnam_ice_ref, namalb, IOSTAT = ios, ERR = 901) 
    194 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namalb in reference namelist', lwp ) 
     194901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namalb in reference namelist' ) 
    195195      REWIND( numnam_ice_cfg )              ! Namelist namalb in configuration namelist : Albedo parameters 
    196196      READ  ( numnam_ice_cfg, namalb, IOSTAT = ios, ERR = 902 ) 
    197 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namalb in configuration namelist', lwp ) 
     197902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namalb in configuration namelist' ) 
    198198      IF(lwm) WRITE( numoni, namalb ) 
    199199      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icedia.F90

    r10425 r11348  
    180180      REWIND( numnam_ice_ref )      ! Namelist namdia in reference namelist : Parameters for ice 
    181181      READ  ( numnam_ice_ref, namdia, IOSTAT = ios, ERR = 901) 
    182 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdia in reference namelist', lwp ) 
     182901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdia in reference namelist' ) 
    183183      REWIND( numnam_ice_cfg )      ! Namelist namdia in configuration namelist : Parameters for ice 
    184184      READ  ( numnam_ice_cfg, namdia, IOSTAT = ios, ERR = 902 ) 
    185 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdia in configuration namelist', lwp ) 
     185902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdia in configuration namelist' ) 
    186186      IF(lwm) WRITE ( numoni, namdia ) 
    187187      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icedyn.F90

    r10994 r11348  
    224224      REWIND( numnam_ice_ref )         ! Namelist namdyn in reference namelist : Ice dynamics 
    225225      READ  ( numnam_ice_ref, namdyn, IOSTAT = ios, ERR = 901) 
    226 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn in reference namelist', lwp ) 
     226901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn in reference namelist' ) 
    227227      REWIND( numnam_ice_cfg )         ! Namelist namdyn in configuration namelist : Ice dynamics 
    228228      READ  ( numnam_ice_cfg, namdyn, IOSTAT = ios, ERR = 902 ) 
    229 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn in configuration namelist', lwp ) 
     229902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn in configuration namelist' ) 
    230230      IF(lwm) WRITE( numoni, namdyn ) 
    231231      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icedyn_adv.F90

    r10911 r11348  
    133133      REWIND( numnam_ice_ref )         ! Namelist namdyn_adv in reference namelist : Ice dynamics 
    134134      READ  ( numnam_ice_ref, namdyn_adv, IOSTAT = ios, ERR = 901) 
    135 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp ) 
     135901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist' ) 
    136136      REWIND( numnam_ice_cfg )         ! Namelist namdyn_adv in configuration namelist : Ice dynamics 
    137137      READ  ( numnam_ice_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 ) 
    138 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp ) 
     138902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist' ) 
    139139      IF(lwm) WRITE( numoni, namdyn_adv ) 
    140140      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icedyn_rdgrft.F90

    r10994 r11348  
    916916      REWIND( numnam_ice_ref )              ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution 
    917917      READ  ( numnam_ice_ref, namdyn_rdgrft, IOSTAT = ios, ERR = 901) 
    918 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist', lwp ) 
     918901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist' ) 
    919919      REWIND( numnam_ice_cfg )              ! Namelist namdyn_rdgrft in configuration namelist : Ice mechanical ice redistribution 
    920920      READ  ( numnam_ice_cfg, namdyn_rdgrft, IOSTAT = ios, ERR = 902 ) 
    921 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist', lwp ) 
     921902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist' ) 
    922922      IF(lwm) WRITE ( numoni, namdyn_rdgrft ) 
    923923      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icedyn_rhg.F90

    r10911 r11348  
    120120      REWIND( numnam_ice_ref )         ! Namelist namdyn_rhg in reference namelist : Ice dynamics 
    121121      READ  ( numnam_ice_ref, namdyn_rhg, IOSTAT = ios, ERR = 901) 
    122 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in reference namelist', lwp ) 
     122901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in reference namelist' ) 
    123123      REWIND( numnam_ice_cfg )         ! Namelist namdyn_rhg in configuration namelist : Ice dynamics 
    124124      READ  ( numnam_ice_cfg, namdyn_rhg, IOSTAT = ios, ERR = 902 ) 
    125 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namdyn_rhg in configuration namelist', lwp ) 
     125902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namdyn_rhg in configuration namelist' ) 
    126126      IF(lwm) WRITE ( numoni, namdyn_rhg ) 
    127127      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/iceistate.F90

    r11263 r11348  
    519519      REWIND( numnam_ice_ref )              ! Namelist namini in reference namelist : Ice initial state 
    520520      READ  ( numnam_ice_ref, namini, IOSTAT = ios, ERR = 901) 
    521 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namini in reference namelist', lwp ) 
     521901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namini in reference namelist' ) 
    522522      REWIND( numnam_ice_cfg )              ! Namelist namini in configuration namelist : Ice initial state 
    523523      READ  ( numnam_ice_cfg, namini, IOSTAT = ios, ERR = 902 ) 
    524 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namini in configuration namelist', lwp ) 
     524902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namini in configuration namelist' ) 
    525525      IF(lwm) WRITE ( numoni, namini ) 
    526526      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/iceitd.F90

    r10994 r11348  
    685685      REWIND( numnam_ice_ref )      ! Namelist namitd in reference namelist : Parameters for ice 
    686686      READ  ( numnam_ice_ref, namitd, IOSTAT = ios, ERR = 901) 
    687 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namitd in reference namelist', lwp ) 
     687901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namitd in reference namelist' ) 
    688688      REWIND( numnam_ice_cfg )      ! Namelist namitd in configuration namelist : Parameters for ice 
    689689      READ  ( numnam_ice_cfg, namitd, IOSTAT = ios, ERR = 902 ) 
    690 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namitd in configuration namelist', lwp ) 
     690902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namitd in configuration namelist' ) 
    691691      IF(lwm) WRITE( numoni, namitd ) 
    692692      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icesbc.F90

    r11334 r11348  
    277277      REWIND( numnam_ice_ref )         ! Namelist namsbc in reference namelist : Ice dynamics 
    278278      READ  ( numnam_ice_ref, namsbc, IOSTAT = ios, ERR = 901) 
    279 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp ) 
     279901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist' ) 
    280280      REWIND( numnam_ice_cfg )         ! Namelist namsbc in configuration namelist : Ice dynamics 
    281281      READ  ( numnam_ice_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 
    282 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp ) 
     282902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist' ) 
    283283      IF(lwm) WRITE( numoni, namsbc ) 
    284284      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icestp.F90

    r10994 r11348  
    303303      REWIND( numnam_ice_ref )      ! Namelist nampar in reference namelist : Parameters for ice 
    304304      READ  ( numnam_ice_ref, nampar, IOSTAT = ios, ERR = 901) 
    305 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampar in reference namelist', lwp ) 
     305901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampar in reference namelist' ) 
    306306      REWIND( numnam_ice_cfg )      ! Namelist nampar in configuration namelist : Parameters for ice 
    307307      READ  ( numnam_ice_cfg, nampar, IOSTAT = ios, ERR = 902 ) 
    308 902   IF( ios > 0 )   CALL ctl_nam ( ios , 'nampar in configuration namelist', lwp ) 
     308902   IF( ios > 0 )   CALL ctl_nam ( ios , 'nampar in configuration namelist' ) 
    309309      IF(lwm) WRITE( numoni, nampar ) 
    310310      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icethd.F90

    r10994 r11348  
    539539      REWIND( numnam_ice_ref )              ! Namelist namthd in reference namelist : Ice thermodynamics 
    540540      READ  ( numnam_ice_ref, namthd, IOSTAT = ios, ERR = 901) 
    541 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd in reference namelist', lwp ) 
     541901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd in reference namelist' ) 
    542542      REWIND( numnam_ice_cfg )              ! Namelist namthd in configuration namelist : Ice thermodynamics 
    543543      READ  ( numnam_ice_cfg, namthd, IOSTAT = ios, ERR = 902 ) 
    544 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd in configuration namelist', lwp ) 
     544902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd in configuration namelist' ) 
    545545      IF(lwm) WRITE( numoni, namthd ) 
    546546      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icethd_da.F90

    r10069 r11348  
    179179      REWIND( numnam_ice_ref )              ! Namelist namthd_da in reference namelist : Ice thermodynamics 
    180180      READ  ( numnam_ice_ref, namthd_da, IOSTAT = ios, ERR = 901) 
    181 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_da in reference namelist', lwp ) 
     181901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_da in reference namelist' ) 
    182182      REWIND( numnam_ice_cfg )              ! Namelist namthd_da in configuration namelist : Ice thermodynamics 
    183183      READ  ( numnam_ice_cfg, namthd_da, IOSTAT = ios, ERR = 902 ) 
    184 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_da in configuration namelist', lwp ) 
     184902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_da in configuration namelist' ) 
    185185      IF(lwm) WRITE( numoni, namthd_da ) 
    186186      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icethd_do.F90

    r11263 r11348  
    443443      REWIND( numnam_ice_ref )              ! Namelist namthd_do in reference namelist : Ice thermodynamics 
    444444      READ  ( numnam_ice_ref, namthd_do, IOSTAT = ios, ERR = 901) 
    445 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_do in reference namelist', lwp ) 
     445901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_do in reference namelist' ) 
    446446      REWIND( numnam_ice_cfg )              ! Namelist namthd_do in configuration namelist : Ice thermodynamics 
    447447      READ  ( numnam_ice_cfg, namthd_do, IOSTAT = ios, ERR = 902 ) 
    448 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_do in configuration namelist', lwp ) 
     448902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_do in configuration namelist' ) 
    449449      IF(lwm) WRITE( numoni, namthd_do ) 
    450450      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icethd_pnd.F90

    r10532 r11348  
    210210      REWIND( numnam_ice_ref )              ! Namelist namthd_pnd  in reference namelist : Melt Ponds   
    211211      READ  ( numnam_ice_ref, namthd_pnd, IOSTAT = ios, ERR = 901) 
    212 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_pnd  in reference namelist', lwp ) 
     212901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_pnd  in reference namelist' ) 
    213213      REWIND( numnam_ice_cfg )              ! Namelist namthd_pnd  in configuration namelist : Melt Ponds 
    214214      READ  ( numnam_ice_cfg, namthd_pnd, IOSTAT = ios, ERR = 902 ) 
    215 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist', lwp ) 
     215902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist' ) 
    216216      IF(lwm) WRITE ( numoni, namthd_pnd ) 
    217217      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icethd_sal.F90

    r10069 r11348  
    134134      REWIND( numnam_ice_ref )              ! Namelist namthd_sal in reference namelist : Ice salinity 
    135135      READ  ( numnam_ice_ref, namthd_sal, IOSTAT = ios, ERR = 901) 
    136 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_sal in reference namelist', lwp ) 
     136901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_sal in reference namelist' ) 
    137137      REWIND( numnam_ice_cfg )              ! Namelist namthd_sal in configuration namelist : Ice salinity 
    138138      READ  ( numnam_ice_cfg, namthd_sal, IOSTAT = ios, ERR = 902 ) 
    139 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_sal in configuration namelist', lwp ) 
     139902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_sal in configuration namelist' ) 
    140140      IF(lwm) WRITE ( numoni, namthd_sal ) 
    141141      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icethd_zdf.F90

    r10534 r11348  
    9090      REWIND( numnam_ice_ref )              ! Namelist namthd_zdf in reference namelist : Ice thermodynamics 
    9191      READ  ( numnam_ice_ref, namthd_zdf, IOSTAT = ios, ERR = 901) 
    92 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_zdf in reference namelist', lwp ) 
     92901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_zdf in reference namelist' ) 
    9393      REWIND( numnam_ice_cfg )              ! Namelist namthd_zdf in configuration namelist : Ice thermodynamics 
    9494      READ  ( numnam_ice_cfg, namthd_zdf, IOSTAT = ios, ERR = 902 ) 
    95 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist', lwp ) 
     95902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist' ) 
    9696      IF(lwm) WRITE( numoni, namthd_zdf ) 
    9797      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icevar.F90

    r11334 r11348  
    778778   !! ** Purpose :  converting N-cat ice to jpl ice categories 
    779779   !!------------------------------------------------------------------- 
    780    SUBROUTINE ice_var_itd_1c1c( zhti, zhts, zati, zh_i, zh_s, za_i ) 
     780   SUBROUTINE ice_var_itd_1c1c( phti, phts, pati ,       ph_i, ph_s, pa_i, & 
     781      &                         ptmi, ptms, ptmsu, psmi, pt_i, pt_s, pt_su, ps_i ) 
    781782      !!------------------------------------------------------------------- 
    782783      !! ** Purpose :  converting 1-cat ice to 1 ice category 
    783784      !!------------------------------------------------------------------- 
    784       REAL(wp), DIMENSION(:), INTENT(in)    ::   zhti, zhts, zati    ! input ice/snow variables 
    785       REAL(wp), DIMENSION(:), INTENT(inout) ::   zh_i, zh_s, za_i    ! output ice/snow variables 
    786       !!------------------------------------------------------------------- 
    787       zh_i(:) = zhti(:) 
    788       zh_s(:) = zhts(:) 
    789       za_i(:) = zati(:) 
     785      REAL(wp), DIMENSION(:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
     786      REAL(wp), DIMENSION(:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
     787      REAL(wp), DIMENSION(:), INTENT(in)   , OPTIONAL ::   ptmi, ptms, ptmsu, psmi    ! input  ice/snow temp & sal 
     788      REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL ::   pt_i, pt_s, pt_su, ps_i    ! output ice/snow temp & sal 
     789      !!------------------------------------------------------------------- 
     790      ! == thickness and concentration == ! 
     791      ph_i(:) = phti(:) 
     792      ph_s(:) = phts(:) 
     793      pa_i(:) = pati(:) 
     794      ! 
     795      ! == temperature and salinity == ! 
     796      IF( PRESENT( pt_i  ) )   pt_i (:) = ptmi (:) 
     797      IF( PRESENT( pt_s  ) )   pt_s (:) = ptms (:) 
     798      IF( PRESENT( pt_su ) )   pt_su(:) = ptmsu(:) 
     799      IF( PRESENT( ps_i  ) )   ps_i (:) = psmi (:) 
     800       
    790801   END SUBROUTINE ice_var_itd_1c1c 
    791802 
    792    SUBROUTINE ice_var_itd_Nc1c( zhti, zhts, zati, zh_i, zh_s, za_i ) 
     803   SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati ,       ph_i, ph_s, pa_i, & 
     804      &                         ptmi, ptms, ptmsu, psmi, pt_i, pt_s, pt_su, ps_i ) 
    793805      !!------------------------------------------------------------------- 
    794806      !! ** Purpose :  converting N-cat ice to 1 ice category 
    795807      !!------------------------------------------------------------------- 
    796       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   zhti, zhts, zati    ! input ice/snow variables 
    797       REAL(wp), DIMENSION(:)  , INTENT(inout) ::   zh_i, zh_s, za_i    ! output ice/snow variables 
    798       !!------------------------------------------------------------------- 
    799       ! 
    800       za_i(:) = SUM( zati(:,:), dim=2 ) 
    801       ! 
    802       WHERE( za_i(:) /= 0._wp ) 
    803          zh_i(:) = SUM( zhti(:,:) * zati(:,:), dim=2 ) / za_i(:) 
    804          zh_s(:) = SUM( zhts(:,:) * zati(:,:), dim=2 ) / za_i(:) 
    805       ELSEWHERE 
    806          zh_i(:) = 0._wp 
    807          zh_s(:) = 0._wp 
     808      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
     809      REAL(wp), DIMENSION(:)  , INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
     810      REAL(wp), DIMENSION(:,:), INTENT(in)   , OPTIONAL ::   ptmi, ptms, ptmsu, psmi    ! input  ice/snow temp & sal 
     811      REAL(wp), DIMENSION(:)  , INTENT(inout), OPTIONAL ::   pt_i, pt_s, pt_su, ps_i    ! output ice/snow temp & sal 
     812      ! 
     813      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   z1_ai, z1_vi, z1_vs 
     814      ! 
     815      INTEGER ::   idim   
     816      !!------------------------------------------------------------------- 
     817      ! 
     818      idim = SIZE( phti, 1 ) 
     819      ! 
     820      ! == thickness and concentration == ! 
     821      ALLOCATE( z1_ai(idim) ) 
     822      ! 
     823      pa_i(:) = SUM( pati(:,:), dim=2 ) 
     824 
     825      WHERE( ( pa_i(:) ) /= 0._wp )   ;   z1_ai(:) = 1._wp / pa_i(:) 
     826      ELSEWHERE                       ;   z1_ai(:) = 0._wp 
    808827      END WHERE 
     828 
     829      ph_i(:) = SUM( phti(:,:) * pati(:,:), dim=2 ) * z1_ai(:) 
     830      ph_s(:) = SUM( phts(:,:) * pati(:,:), dim=2 ) * z1_ai(:) 
     831      ! 
     832      ! == temperature and salinity == ! 
     833      IF( PRESENT( pt_i ) .OR. PRESENT( pt_s ) .OR. PRESENT( pt_su ) .OR. PRESENT( ps_i ) ) THEN 
     834         ! 
     835         ALLOCATE( z1_vi(idim), z1_vs(idim) ) 
     836         ! 
     837         WHERE( ( pa_i(:) * ph_i(:) ) /= 0._wp )   ;   z1_vi(:) = 1._wp / ( pa_i(:) * ph_i(:) ) 
     838         ELSEWHERE                                 ;   z1_vi(:) = 0._wp 
     839         END WHERE 
     840         WHERE( ( pa_i(:) * ph_s(:) ) /= 0._wp )   ;   z1_vs(:) = 1._wp / ( pa_i(:) * ph_s(:) ) 
     841         ELSEWHERE                                 ;   z1_vs(:) = 0._wp 
     842         END WHERE 
     843         ! 
     844         IF( PRESENT( pt_i  ) )   pt_i (:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 
     845         IF( PRESENT( pt_s  ) )   pt_s (:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 
     846         IF( PRESENT( pt_su ) )   pt_su(:) = SUM( ptmsu(:,:) * pati(:,:)            , dim=2 ) * z1_ai(:) 
     847         IF( PRESENT( ps_i  ) )   ps_i (:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 
     848         ! 
     849         DEALLOCATE( z1_vi, z1_vs ) 
     850         ! 
     851      ENDIF 
     852      ! 
     853      DEALLOCATE( z1_ai ) 
    809854      ! 
    810855   END SUBROUTINE ice_var_itd_Nc1c 
    811856    
    812    SUBROUTINE ice_var_itd_1cMc( zhti, zhts, zati, zh_i, zh_s, za_i ) 
     857   SUBROUTINE ice_var_itd_1cMc( phti, phts, pati ,       ph_i, ph_s, pa_i, & 
     858      &                         ptmi, ptms, ptmsu, psmi, pt_i, pt_s, pt_su, ps_i ) 
    813859      !!------------------------------------------------------------------- 
    814860      !! 
     
    831877      !!               4) Iterate until ok (SUM(itest(:) = 4) 
    832878      !! 
    833       !! ** Arguments : zhti: 1-cat ice thickness 
    834       !!                zhts: 1-cat snow depth 
    835       !!                zati: 1-cat ice concentration 
     879      !! ** Arguments : phti: 1-cat ice thickness 
     880      !!                phts: 1-cat snow depth 
     881      !!                pati: 1-cat ice concentration 
    836882      !! 
    837883      !! ** Output    : jpl-cat  
     
    839885      !!  (Example of application: BDY forcings when input are cell averaged)   
    840886      !!------------------------------------------------------------------- 
    841       INTEGER  :: ji, jk, jl             ! dummy loop indices 
    842       INTEGER  :: idim, i_fill, jl0   
    843       REAL(wp) :: zarg, zV, zconv, zdh, zdv 
    844       REAL(wp), DIMENSION(:),   INTENT(in)    ::   zhti, zhts, zati    ! input  ice/snow variables 
    845       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zh_i, zh_s, za_i    ! output ice/snow variables 
    846       INTEGER , DIMENSION(4)                  ::   itest 
    847       !!------------------------------------------------------------------- 
    848       ! 
    849       ! ---------------------------------------- 
     887      REAL(wp), DIMENSION(:),   INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
     888      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
     889      REAL(wp), DIMENSION(:)  , INTENT(in)   , OPTIONAL ::   ptmi, ptms, ptmsu, psmi    ! input  ice/snow temp & sal 
     890      REAL(wp), DIMENSION(:,:), INTENT(inout), OPTIONAL ::   pt_i, pt_s, pt_su, ps_i    ! output ice/snow temp & sal 
     891      ! 
     892      INTEGER , DIMENSION(4) ::   itest 
     893      INTEGER  ::   ji, jk, jl 
     894      INTEGER  ::   idim, i_fill, jl0   
     895      REAL(wp) ::   zarg, zV, zconv, zdh, zdv 
     896      !!------------------------------------------------------------------- 
     897      ! 
     898      ! == thickness and concentration == ! 
    850899      ! distribution over the jpl ice categories 
    851       ! ---------------------------------------- 
    852       ! a gaussian distribution for ice concentration is used 
    853       ! then we check whether the distribution fullfills 
    854       ! volume and area conservation, positivity and ice categories bounds 
    855       idim = SIZE( zhti , 1 ) 
    856       zh_i(1:idim,1:jpl) = 0._wp 
    857       zh_s(1:idim,1:jpl) = 0._wp 
    858       za_i(1:idim,1:jpl) = 0._wp 
    859       ! 
    860       IF( jpl == 1 ) THEN 
    861          CALL ice_var_itd_1c1c( zhti, zhts, zati, zh_i(:,1), zh_s(:,1), za_i(:,1) ) 
    862          RETURN 
    863       ENDIF 
     900      !    a gaussian distribution for ice concentration is used 
     901      !    then we check whether the distribution fullfills 
     902      !    volume and area conservation, positivity and ice categories bounds 
     903      idim = SIZE( phti , 1 ) 
     904      ! 
     905      ph_i(1:idim,1:jpl) = 0._wp 
     906      ph_s(1:idim,1:jpl) = 0._wp 
     907      pa_i(1:idim,1:jpl) = 0._wp 
    864908      ! 
    865909      DO ji = 1, idim 
    866910         ! 
    867          IF( zhti(ji) > 0._wp ) THEN 
     911         IF( phti(ji) > 0._wp ) THEN 
    868912            ! 
    869913            ! find which category (jl0) the input ice thickness falls into 
    870914            jl0 = jpl 
    871915            DO jl = 1, jpl 
    872                IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN 
     916               IF ( ( phti(ji) >= hi_max(jl-1) ) .AND. ( phti(ji) < hi_max(jl) ) ) THEN 
    873917                  jl0 = jl 
    874918                  CYCLE 
     
    882926               i_fill = i_fill - 1 
    883927               ! 
    884                zh_i(ji,1:jpl) = 0._wp 
    885                za_i(ji,1:jpl) = 0._wp 
     928               ph_i(ji,1:jpl) = 0._wp 
     929               pa_i(ji,1:jpl) = 0._wp 
    886930               itest(:)       = 0       
    887931               ! 
    888932               IF ( i_fill == 1 ) THEN      !-- case very thin ice: fill only category 1 
    889                   zh_i(ji,1) = zhti(ji) 
    890                   za_i (ji,1) = zati (ji) 
     933                  ph_i(ji,1) = phti(ji) 
     934                  pa_i (ji,1) = pati (ji) 
    891935               ELSE                         !-- case ice is thicker: fill categories >1 
    892936                  ! thickness 
    893937                  DO jl = 1, i_fill - 1 
    894                      zh_i(ji,jl) = hi_mean(jl) 
     938                     ph_i(ji,jl) = hi_mean(jl) 
    895939                  END DO 
    896940                  ! 
    897941                  ! concentration 
    898                   za_i(ji,jl0) = zati(ji) / SQRT(REAL(jpl)) 
     942                  pa_i(ji,jl0) = pati(ji) / SQRT(REAL(jpl)) 
    899943                  DO jl = 1, i_fill - 1 
    900944                     IF ( jl /= jl0 ) THEN 
    901                         zarg        = ( zh_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp ) 
    902                         za_i(ji,jl) =   za_i (ji,jl0) * EXP(-zarg**2) 
     945                        zarg        = ( ph_i(ji,jl) - phti(ji) ) / ( phti(ji) * 0.5_wp ) 
     946                        pa_i(ji,jl) =   pa_i (ji,jl0) * EXP(-zarg**2) 
    903947                     ENDIF 
    904948                  END DO 
    905949                  ! 
    906950                  ! last category 
    907                   za_i(ji,i_fill) = zati(ji) - SUM( za_i(ji,1:i_fill-1) ) 
    908                   zV = SUM( za_i(ji,1:i_fill-1) * zh_i(ji,1:i_fill-1) ) 
    909                   zh_i(ji,i_fill) = ( zhti(ji) * zati(ji) - zV ) / MAX( za_i(ji,i_fill), epsi10 )  
     951                  pa_i(ji,i_fill) = pati(ji) - SUM( pa_i(ji,1:i_fill-1) ) 
     952                  zV = SUM( pa_i(ji,1:i_fill-1) * ph_i(ji,1:i_fill-1) ) 
     953                  ph_i(ji,i_fill) = ( phti(ji) * pati(ji) - zV ) / MAX( pa_i(ji,i_fill), epsi10 )  
    910954                  ! 
    911955                  ! correction if concentration of upper cat is greater than lower cat 
     
    913957                  IF ( jl0 /= jpl ) THEN 
    914958                     DO jl = jpl, jl0+1, -1 
    915                         IF ( za_i(ji,jl) > za_i(ji,jl-1) ) THEN 
    916                            zdv = zh_i(ji,jl) * za_i(ji,jl) 
    917                            zh_i(ji,jl    ) = 0._wp 
    918                            za_i (ji,jl    ) = 0._wp 
    919                            za_i (ji,1:jl-1) = za_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * zhti(ji), epsi10 ) 
     959                        IF ( pa_i(ji,jl) > pa_i(ji,jl-1) ) THEN 
     960                           zdv = ph_i(ji,jl) * pa_i(ji,jl) 
     961                           ph_i(ji,jl    ) = 0._wp 
     962                           pa_i (ji,jl    ) = 0._wp 
     963                           pa_i (ji,1:jl-1) = pa_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * phti(ji), epsi10 ) 
    920964                        END IF 
    921965                     END DO 
     
    925969               ! 
    926970               ! Compatibility tests 
    927                zconv = ABS( zati(ji) - SUM( za_i(ji,1:jpl) ) )  
     971               zconv = ABS( pati(ji) - SUM( pa_i(ji,1:jpl) ) )  
    928972               IF ( zconv < epsi06 )   itest(1) = 1                                        ! Test 1: area conservation 
    929973               ! 
    930                zconv = ABS( zhti(ji)*zati(ji) - SUM( za_i(ji,1:jpl)*zh_i(ji,1:jpl) ) ) 
     974               zconv = ABS( phti(ji)*pati(ji) - SUM( pa_i(ji,1:jpl)*ph_i(ji,1:jpl) ) ) 
    931975               IF ( zconv < epsi06 )   itest(2) = 1                                        ! Test 2: volume conservation 
    932976               ! 
    933                IF ( zh_i(ji,i_fill) >= hi_max(i_fill-1) )   itest(3) = 1                  ! Test 3: thickness of the last category is in-bounds ? 
     977               IF ( ph_i(ji,i_fill) >= hi_max(i_fill-1) )   itest(3) = 1                  ! Test 3: thickness of the last category is in-bounds ? 
    934978               ! 
    935979               itest(4) = 1 
    936980               DO jl = 1, i_fill 
    937                   IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0                                ! Test 4: positivity of ice concentrations 
     981                  IF ( pa_i(ji,jl) < 0._wp ) itest(4) = 0                                ! Test 4: positivity of ice concentrations 
    938982               END DO 
    939983               !                                         !---------------------------- 
     
    943987      END DO 
    944988 
    945       ! Add Snow in each category where za_i is not 0 
     989      ! Add Snow in each category where pa_i is not 0 
    946990      DO jl = 1, jpl 
    947991         DO ji = 1, idim 
    948             IF( za_i(ji,jl) > 0._wp ) THEN 
    949                zh_s(ji,jl) = zh_i(ji,jl) * ( zhts(ji) / zhti(ji) ) 
     992            IF( pa_i(ji,jl) > 0._wp ) THEN 
     993               ph_s(ji,jl) = ph_i(ji,jl) * ( phts(ji) / phti(ji) ) 
    950994               ! In case snow load is in excess that would lead to transformation from snow to ice 
    951995               ! Then, transfer the snow excess into the ice (different from icethd_dh) 
    952                zdh = MAX( 0._wp, ( rhos * zh_s(ji,jl) + ( rhoi - rau0 ) * zh_i(ji,jl) ) * r1_rau0 )  
     996               zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rau0 ) * ph_i(ji,jl) ) * r1_rau0 )  
    953997               ! recompute h_i, h_s avoiding out of bounds values 
    954                zh_i(ji,jl) = MIN( hi_max(jl), zh_i(ji,jl) + zdh ) 
    955                zh_s(ji,jl) = MAX( 0._wp, zh_s(ji,jl) - zdh * rhoi * r1_rhos ) 
     998               ph_i(ji,jl) = MIN( hi_max(jl), ph_i(ji,jl) + zdh ) 
     999               ph_s(ji,jl) = MAX( 0._wp, ph_s(ji,jl) - zdh * rhoi * r1_rhos ) 
    9561000            ENDIF 
    9571001         END DO 
    9581002      END DO 
    9591003      ! 
     1004      ! == temperature and salinity == ! 
     1005      IF( PRESENT( pt_i  ) ) THEN 
     1006         DO jl = 1, jpl 
     1007            pt_i(:,jl) = ptmi (:) 
     1008         END DO 
     1009      ENDIF 
     1010      IF( PRESENT( pt_s  ) ) THEN 
     1011         DO jl = 1, jpl 
     1012            pt_s (:,jl) = ptms (:) 
     1013         END DO 
     1014      ENDIF 
     1015      IF( PRESENT( pt_su ) ) THEN 
     1016         DO jl = 1, jpl 
     1017            pt_su(:,jl) = ptmsu(:) 
     1018         END DO 
     1019      ENDIF 
     1020      IF( PRESENT( ps_i  ) ) THEN 
     1021         DO jl = 1, jpl 
     1022            ps_i (:,jl) = psmi (:) 
     1023         END DO 
     1024      ENDIF 
     1025      ! 
    9601026   END SUBROUTINE ice_var_itd_1cMc 
    9611027 
    962    SUBROUTINE ice_var_itd_NcMc( zhti, zhts, zati, zh_i, zh_s, za_i ) 
     1028   SUBROUTINE ice_var_itd_NcMc( phti, phts, pati ,       ph_i, ph_s, pa_i, & 
     1029      &                         ptmi, ptms, ptmsu, psmi, pt_i, pt_s, pt_su, ps_i ) 
    9631030      !!------------------------------------------------------------------- 
    9641031      !! 
     
    9811048      !!                      b) removing 25% ice area from the higher cat (descendant loop jlmax=>jlmin) 
    9821049      !! 
    983       !! ** Arguments : zhti: N-cat ice thickness 
    984       !!                zhts: N-cat snow depth 
    985       !!                zati: N-cat ice concentration 
     1050      !! ** Arguments : phti: N-cat ice thickness 
     1051      !!                phts: N-cat snow depth 
     1052      !!                pati: N-cat ice concentration 
    9861053      !! 
    9871054      !! ** Output    : jpl-cat  
     
    9891056      !!  (Example of application: BDY forcings when inputs have N-cat /= jpl)   
    9901057      !!------------------------------------------------------------------- 
    991       INTEGER  ::   ji, jl, jl1, jl2             ! dummy loop indices 
     1058      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
     1059      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
     1060      REAL(wp), DIMENSION(:,:), INTENT(in)   , OPTIONAL ::   ptmi, ptms, ptmsu, psmi    ! input  ice/snow temp & sal 
     1061      REAL(wp), DIMENSION(:,:), INTENT(inout), OPTIONAL ::   pt_i, pt_s, pt_su, ps_i    ! output ice/snow temp & sal 
     1062      ! 
     1063      INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   jlfil, jlfil2 
     1064      INTEGER , ALLOCATABLE, DIMENSION(:)   ::   jlmax, jlmin 
     1065      REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   z1_ai, z1_vi, z1_vs, ztmp 
     1066      ! 
     1067      REAL(wp), PARAMETER ::   ztrans = 0.25_wp 
     1068      INTEGER  ::   ji, jl, jl1, jl2 
    9921069      INTEGER  ::   idim, icat   
    993       REAL(wp), PARAMETER ::   ztrans = 0.25_wp 
    994       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   zhti, zhts, zati    ! input ice/snow variables 
    995       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zh_i, zh_s, za_i    ! output ice/snow variables 
    996       INTEGER , DIMENSION(:,:), ALLOCATABLE   ::   jlfil, jlfil2 
    997       INTEGER , DIMENSION(:)  , ALLOCATABLE   ::   jlmax, jlmin 
    998       !!------------------------------------------------------------------- 
    999       ! 
    1000       idim = SIZE( zhti, 1 ) 
    1001       icat = SIZE( zhti, 2 ) 
     1070      !!------------------------------------------------------------------- 
     1071      ! 
     1072      idim = SIZE( phti, 1 ) 
     1073      icat = SIZE( phti, 2 ) 
     1074      ! 
     1075      ! == thickness and concentration == ! 
    10021076      !                                 ! ---------------------- ! 
    10031077      IF( icat == jpl ) THEN            ! input cat = output cat ! 
    10041078         !                              ! ---------------------- ! 
    1005          zh_i(:,:) = zhti(:,:) 
    1006          zh_s(:,:) = zhts(:,:) 
    1007          za_i(:,:) = zati(:,:) 
     1079         ph_i(:,:) = phti(:,:) 
     1080         ph_s(:,:) = phts(:,:) 
     1081         pa_i(:,:) = pati(:,:) 
     1082         ! 
     1083         ! == temperature and salinity == ! 
     1084         IF( PRESENT( pt_i  ) )   pt_i (:,:) = ptmi (:,:) 
     1085         IF( PRESENT( pt_s  ) )   pt_s (:,:) = ptms (:,:) 
     1086         IF( PRESENT( pt_su ) )   pt_su(:,:) = ptmsu(:,:) 
     1087         IF( PRESENT( ps_i  ) )   ps_i (:,:) = psmi (:,:) 
    10081088         !                              ! ---------------------- ! 
    1009       ELSEIF( icat == 1 ) THEN          ! specific case if N = 1 ! 
     1089      ELSEIF( icat == 1 ) THEN          ! input cat = 1          ! 
    10101090         !                              ! ---------------------- ! 
    1011          ! 
    1012          CALL ice_var_itd_1cMc( zhti(:,1), zhts(:,1), zati(:,1), zh_i, zh_s, za_i ) 
    1013          ! 
     1091         CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1),            ph_i(:,:), ph_s(:,:), pa_i (:,:), & 
     1092            &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:) ) 
    10141093         !                              ! ---------------------- ! 
    1015       ELSEIF( jpl == 1 ) THEN           ! specific case if M = 1 ! 
     1094      ELSEIF( jpl == 1 ) THEN           ! output cat = 1        ! 
    10161095         !                              ! ---------------------- ! 
    1017          ! 
    1018          CALL ice_var_itd_Nc1c( zhti, zhts, zati, zh_i(:,1), zh_s(:,1), za_i(:,1) ) 
    1019          ! 
     1096         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:),            ph_i(:,1), ph_s(:,1), pa_i (:,1), & 
     1097            &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1) )          
    10201098         !                              ! ----------------------- ! 
    10211099      ELSE                              ! input cat /= output cat ! 
     
    10261104 
    10271105         ! --- initialize output fields to 0 --- ! 
    1028          zh_i(1:idim,1:jpl) = 0._wp 
    1029          zh_s(1:idim,1:jpl) = 0._wp 
    1030          za_i(1:idim,1:jpl) = 0._wp 
     1106         ph_i(1:idim,1:jpl) = 0._wp 
     1107         ph_s(1:idim,1:jpl) = 0._wp 
     1108         pa_i(1:idim,1:jpl) = 0._wp 
    10311109         ! 
    10321110         ! --- fill the categories --- ! 
     
    10381116            DO jl2 = 1, icat 
    10391117               DO ji = 1, idim 
    1040                   IF( hi_max(jl1-1) <= zhti(ji,jl2) .AND. hi_max(jl1) > zhti(ji,jl2) ) THEN 
     1118                  IF( hi_max(jl1-1) <= phti(ji,jl2) .AND. hi_max(jl1) > phti(ji,jl2) ) THEN 
    10411119                     ! fill the right category 
    1042                      zh_i(ji,jl1) = zhti(ji,jl2) 
    1043                      zh_s(ji,jl1) = zhts(ji,jl2) 
    1044                      za_i(ji,jl1) = zati(ji,jl2) 
     1120                     ph_i(ji,jl1) = phti(ji,jl2) 
     1121                     ph_s(ji,jl1) = phts(ji,jl2) 
     1122                     pa_i(ji,jl1) = pati(ji,jl2) 
    10451123                     ! record categories that are filled 
    10461124                     jlmax(ji) = MAX( jlmax(ji), jl1 ) 
     
    10591137            IF( jl1 > 1 ) THEN 
    10601138               ! fill the lower cat (jl1-1) 
    1061                za_i(ji,jl1-1) = ztrans * za_i(ji,jl1) 
    1062                zh_i(ji,jl1-1) = hi_mean(jl1-1) 
     1139               pa_i(ji,jl1-1) = ztrans * pa_i(ji,jl1) 
     1140               ph_i(ji,jl1-1) = hi_mean(jl1-1) 
    10631141               ! remove from cat jl1 
    1064                za_i(ji,jl1  ) = ( 1._wp - ztrans ) * za_i(ji,jl1) 
     1142               pa_i(ji,jl1  ) = ( 1._wp - ztrans ) * pa_i(ji,jl1) 
    10651143            ENDIF 
    10661144            IF( jl2 < jpl ) THEN 
    10671145               ! fill the upper cat (jl2+1) 
    1068                za_i(ji,jl2+1) = ztrans * za_i(ji,jl2) 
    1069                zh_i(ji,jl2+1) = hi_mean(jl2+1) 
     1146               pa_i(ji,jl2+1) = ztrans * pa_i(ji,jl2) 
     1147               ph_i(ji,jl2+1) = hi_mean(jl2+1) 
    10701148               ! remove from cat jl2 
    1071                za_i(ji,jl2  ) = ( 1._wp - ztrans ) * za_i(ji,jl2) 
     1149               pa_i(ji,jl2  ) = ( 1._wp - ztrans ) * pa_i(ji,jl2) 
    10721150            ENDIF 
    10731151         END DO 
     
    10791157               IF( jlfil(ji,jl-1) /= 0 .AND. jlfil(ji,jl) == 0 ) THEN 
    10801158                  ! fill high 
    1081                   za_i(ji,jl) = ztrans * za_i(ji,jl-1) 
    1082                   zh_i(ji,jl) = hi_mean(jl) 
     1159                  pa_i(ji,jl) = ztrans * pa_i(ji,jl-1) 
     1160                  ph_i(ji,jl) = hi_mean(jl) 
    10831161                  jlfil(ji,jl) = jl 
    10841162                  ! remove low 
    1085                   za_i(ji,jl-1) = ( 1._wp - ztrans ) * za_i(ji,jl-1) 
     1163                  pa_i(ji,jl-1) = ( 1._wp - ztrans ) * pa_i(ji,jl-1) 
    10861164               ENDIF 
    10871165            END DO 
     
    10931171               IF( jlfil2(ji,jl+1) /= 0 .AND. jlfil2(ji,jl) == 0 ) THEN 
    10941172                  ! fill low 
    1095                   za_i(ji,jl) = za_i(ji,jl) + ztrans * za_i(ji,jl+1) 
    1096                   zh_i(ji,jl) = hi_mean(jl)  
     1173                  pa_i(ji,jl) = pa_i(ji,jl) + ztrans * pa_i(ji,jl+1) 
     1174                  ph_i(ji,jl) = hi_mean(jl)  
    10971175                  jlfil2(ji,jl) = jl 
    10981176                  ! remove high 
    1099                   za_i(ji,jl+1) = ( 1._wp - ztrans ) * za_i(ji,jl+1) 
     1177                  pa_i(ji,jl+1) = ( 1._wp - ztrans ) * pa_i(ji,jl+1) 
    11001178               ENDIF 
    11011179            END DO 
     
    11041182         DEALLOCATE( jlfil, jlfil2 )      ! deallocate arrays 
    11051183         DEALLOCATE( jlmin, jlmax ) 
     1184         ! 
     1185         ! == temperature and salinity == ! 
     1186         ! 
     1187         IF( PRESENT( pt_i ) .OR. PRESENT( pt_s ) .OR. PRESENT( pt_su ) .OR. PRESENT( ps_i ) ) THEN 
     1188            ! 
     1189            ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim), ztmp(idim) ) 
     1190            ! 
     1191            WHERE( SUM( pa_i(:,:), dim=2 ) /= 0._wp )               ;   z1_ai(:) = 1._wp / SUM( pa_i(:,:), dim=2 ) 
     1192            ELSEWHERE                                               ;   z1_ai(:) = 0._wp 
     1193            END WHERE 
     1194            WHERE( SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) /= 0._wp )   ;   z1_vi(:) = 1._wp / SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) 
     1195            ELSEWHERE                                               ;   z1_vi(:) = 0._wp 
     1196            END WHERE 
     1197            WHERE( SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) /= 0._wp )   ;   z1_vs(:) = 1._wp / SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) 
     1198            ELSEWHERE                                               ;   z1_vs(:) = 0._wp 
     1199            END WHERE 
     1200            ! 
     1201            ! fill all the categories with the same value 
     1202            IF( PRESENT( pt_i  ) ) THEN 
     1203               ztmp(:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 
     1204               DO jl = 1, jpl 
     1205                  pt_i (:,jl) = ztmp(:) 
     1206               END DO 
     1207            ENDIF 
     1208            IF( PRESENT( pt_s  ) ) THEN 
     1209               ztmp(:) =  SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 
     1210               DO jl = 1, jpl 
     1211                  pt_s (:,jl) = ztmp(:) 
     1212               END DO 
     1213            ENDIF 
     1214            IF( PRESENT( pt_su ) ) THEN 
     1215               ztmp(:) = SUM( ptmsu(:,:) * pati(:,:)            , dim=2 ) * z1_ai(:) 
     1216               DO jl = 1, jpl 
     1217                  pt_su(:,jl) = ztmp(:) 
     1218               END DO 
     1219            ENDIF 
     1220            IF( PRESENT( ps_i  ) ) THEN 
     1221               ztmp(:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 
     1222               DO jl = 1, jpl 
     1223                  ps_i (:,jl) = ztmp(:) 
     1224               END DO 
     1225            ENDIF 
     1226            ! 
     1227            DEALLOCATE( z1_ai, z1_vi, z1_vs, ztmp ) 
     1228            ! 
     1229         ENDIF 
    11061230         ! 
    11071231      ENDIF 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/NST/agrif_user.F90

    r10425 r11348  
    714714   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom 
    715715   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 
    716 901 IF( ios /= 0 )   CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp ) 
     716901 IF( ios /= 0 )   CALL ctl_nam ( ios , 'namagrif in reference namelist' ) 
    717717   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom 
    718718   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 
    719 902 IF( ios >  0 )   CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp ) 
     719902 IF( ios >  0 )   CALL ctl_nam ( ios , 'namagrif in configuration namelist' ) 
    720720   IF(lwm) WRITE ( numond, namagrif ) 
    721721   ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/ASM/asminc.F90

    r10425 r11348  
    147147      REWIND( numnam_ref )              ! Namelist nam_asminc in reference namelist : Assimilation increment 
    148148      READ  ( numnam_ref, nam_asminc, IOSTAT = ios, ERR = 901) 
    149 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_asminc in reference namelist', lwp ) 
     149901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_asminc in reference namelist' ) 
    150150      REWIND( numnam_cfg )              ! Namelist nam_asminc in configuration namelist : Assimilation increment 
    151151      READ  ( numnam_cfg, nam_asminc, IOSTAT = ios, ERR = 902 ) 
    152 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_asminc in configuration namelist', lwp ) 
     152902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_asminc in configuration namelist' ) 
    153153      IF(lwm) WRITE ( numond, nam_asminc ) 
    154154 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/BDY/bdydta.F90

    r11268 r11348  
    376376         REWIND(numnam_ref) 
    377377         READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 
    378 901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) 
     378901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist' ) 
    379379 
    380380         !   by-pass nambdy_dta reading if no input data used in this bdy    
     
    385385            ! WARNING: we don't do a rewind here, each bdy reads its own nambdy_dta block one after another 
    386386            READ  ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 ) 
    387 902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp ) 
     387902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist' ) 
    388388            IF(lwm) WRITE( numond, nambdy_dta )            
    389389         ENDIF 
     
    415415               bf_alias => bf(jp_bdyssh,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy 
    416416               bn_alias => bn_ssh                                          ! alias for ssh structure of nambdy_dta  
     417               iszdim = idx_bdy(jbdy)%nblenrim(igrd)                       ! length of this bdy on this MPI processus : only rim 
    417418            ENDIF 
    418419            ! ===================== 
     
    427428               bf_alias => bf(jp_bdyu2d,jbdy:jbdy)                         ! alias for u2d structure of bdy number jbdy 
    428429               bn_alias => bn_u2d                                          ! alias for u2d structure of nambdy_dta  
     430               iszdim = idx_bdy(jbdy)%nblenrim(igrd)                       ! length of this bdy on this MPI processus : only rim 
    429431            ENDIF 
    430432            IF( jfld == jp_bdyv2d ) THEN 
     
    436438               bf_alias => bf(jp_bdyv2d,jbdy:jbdy)                         ! alias for v2d structure of bdy number jbdy 
    437439               bn_alias => bn_v2d                                          ! alias for v2d structure of nambdy_dta  
     440               iszdim = idx_bdy(jbdy)%nblenrim(igrd)                       ! length of this bdy on this MPI processus : only rim 
    438441            ENDIF 
    439442            ! ===================== 
     
    449452               bf_alias => bf(jp_bdyu3d,jbdy:jbdy)                         ! alias for u3d structure of bdy number jbdy 
    450453               bn_alias => bn_u3d                                          ! alias for u3d structure of nambdy_dta  
    451             ENDIF 
     454               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus 
     455           ENDIF 
    452456            IF( jfld == jp_bdyv3d ) THEN 
    453457               cl3 = 'v3d' 
     
    459463               bf_alias => bf(jp_bdyv3d,jbdy:jbdy)                         ! alias for v3d structure of bdy number jbdy 
    460464               bn_alias => bn_v3d                                          ! alias for v3d structure of nambdy_dta  
    461             ENDIF 
     465               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus 
     466           ENDIF 
    462467 
    463468            ! ===================== 
     
    472477               bf_alias => bf(jp_bdytem,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy 
    473478               bn_alias => bn_tem                                          ! alias for ssh structure of nambdy_dta  
     479               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus 
    474480            ENDIF 
    475481            IF( jfld == jp_bdysal ) THEN 
     
    481487               bf_alias => bf(jp_bdysal,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy 
    482488               bn_alias => bn_sal                                          ! alias for ssh structure of nambdy_dta  
     489               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus 
    483490            ENDIF 
    484491 
     
    494501               bf_alias => bf(jp_bdya_i,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy 
    495502               bn_alias => bn_a_i                                          ! alias for ssh structure of nambdy_dta  
    496             ENDIF 
     503               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus 
     504           ENDIF 
    497505            IF( jfld == jp_bdyh_i ) THEN 
    498506               cl3 = 'h_i' 
     
    503511               bf_alias => bf(jp_bdyh_i,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy 
    504512               bn_alias => bn_h_i                                          ! alias for ssh structure of nambdy_dta  
     513               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus 
    505514            ENDIF 
    506515            IF( jfld == jp_bdyh_s ) THEN 
     
    512521               bf_alias => bf(jp_bdyh_s,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy 
    513522               bn_alias => bn_h_s                                          ! alias for ssh structure of nambdy_dta  
    514             ENDIF 
    515  
     523               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus 
     524            ENDIF 
    516525 
    517526            IF( llneed ) THEN                                              ! dta_bdy(jbdy)%xxx will be needed 
    518527               !                                                           !   -> must be associated with an allocated target 
    519                iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus 
    520528               ALLOCATE( bf_alias(1)%fnow( iszdim, 1, ipk ) )              ! allocate the target 
    521529               ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/BDY/bdyini.F90

    r11258 r11348  
    7878      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries 
    7979      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901) 
    80 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
     80901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist' ) 
    8181      ! make sur that all elements of the namelist variables have a default definition from namelist_ref 
    8282      ln_coords_file (2:jp_bdy) = ln_coords_file (1) 
     
    9999      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries 
    100100      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 ) 
    101 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
     101902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist' ) 
    102102      IF(lwm) WRITE ( numond, nambdy ) 
    103103 
     
    10941094      ! keep full control of the configuration namelist 
    10951095      READ  ( numnam_cfg, nambdy_index, IOSTAT = ios, ERR = 904 ) 
    1096 904   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_index in configuration namelist', lwp ) 
     1096904   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_index in configuration namelist' ) 
    10971097      IF(lwm) WRITE ( numond, nambdy_index ) 
    10981098       
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/BDY/bdytides.F90

    r11223 r11348  
    9696            REWIND( numnam_ref ) 
    9797            READ  ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901) 
    98 901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_tide in reference namelist', lwp ) 
     98901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_tide in reference namelist' ) 
    9999            ! Don't REWIND here - may need to read more than one of these namelists.  
    100100            READ  ( numnam_cfg, nambdy_tide, IOSTAT = ios, ERR = 902 ) 
    101 902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist', lwp ) 
     101902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist' ) 
    102102            IF(lwm) WRITE ( numond, nambdy_tide ) 
    103103            !                                               ! Parameter control and print 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/C1D/c1d.F90

    r10068 r11348  
    5252      REWIND( numnam_ref )              ! Namelist namc1d in reference namelist : Tracer advection scheme 
    5353      READ  ( numnam_ref, namc1d, IOSTAT = ios, ERR = 901) 
    54 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d in reference namelist', lwp ) 
     54901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d in reference namelist' ) 
    5555      ! 
    5656      REWIND( numnam_cfg )              ! Namelist namtra_adv in configuration namelist : Tracer advection scheme 
    5757      READ  ( numnam_cfg, namc1d, IOSTAT = ios, ERR = 902 ) 
    58 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc1d in configuration namelist', lwp ) 
     58902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc1d in configuration namelist' ) 
    5959      IF(lwm) WRITE ( numond, namc1d ) 
    6060      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/C1D/dtauvd.F90

    r10068 r11348  
    6262      REWIND( numnam_ref )              ! Namelist namc1d_uvd in reference namelist :  
    6363      READ  ( numnam_ref, namc1d_uvd, IOSTAT = ios, ERR = 901) 
    64 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist', lwp ) 
     64901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist' ) 
    6565      ! 
    6666      REWIND( numnam_cfg )              ! Namelist namc1d_uvd in configuration namelist : Parameters of the run 
    6767      READ  ( numnam_cfg, namc1d_uvd, IOSTAT = ios, ERR = 902 ) 
    68 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist', lwp ) 
     68902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist' ) 
    6969      IF(lwm) WRITE ( numond, namc1d_uvd ) 
    7070 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/C1D/dyndmp.F90

    r10425 r11348  
    8181      REWIND( numnam_ref )              ! Namelist namc1d_dyndmp in reference namelist :  
    8282      READ  ( numnam_ref, namc1d_dyndmp, IOSTAT = ios, ERR = 901) 
    83 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist', lwp ) 
     83901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist' ) 
    8484      REWIND( numnam_cfg )              ! Namelist namc1d_dyndmp in configuration namelist : Parameters of the run 
    8585      READ  ( numnam_cfg, namc1d_dyndmp, IOSTAT = ios, ERR = 902 ) 
    86 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist', lwp ) 
     86902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist' ) 
    8787      IF(lwm) WRITE ( numond, namc1d_dyndmp ) 
    8888      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/CRS/crsdom.F90

    r11192 r11348  
    579579                  ENDDO   
    580580               CASE DEFAULT 
    581                     STOP 
     581                  CALL ctl_stop( 'STOP', 'error from crs_dom_ope_3d, you should not be there...' ) 
    582582               END SELECT 
    583583 
     
    19471947                 
    19481948              CASE DEFAULT 
    1949                  STOP 
     1949                 CALL ctl_stop( 'STOP', 'error from crs_dom_def, you should not be there (1) ...' ) 
    19501950           END SELECT 
    19511951           IF( nlcjt_crs(jn) > jpj_crs )     jpj_crs = jpj_crs + 1 
     
    19961996 
    19971997              CASE DEFAULT 
    1998                  STOP 
     1998                 CALL ctl_stop( 'STOP', 'error from crs_dom_def, you should not be there (2) ...' ) 
    19991999           END SELECT 
    20002000 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/CRS/crsini.F90

    r10068 r11348  
    8282      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run 
    8383      READ  ( numnam_ref, namcrs, IOSTAT = ios, ERR = 901) 
    84 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcrs in reference namelist', lwp ) 
     84901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcrs in reference namelist' ) 
    8585      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run 
    8686      READ  ( numnam_cfg, namcrs, IOSTAT = ios, ERR = 902 ) 
    87 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcrs in configuration namelist', lwp ) 
     87902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcrs in configuration namelist' ) 
    8888      IF(lwm) WRITE ( numond, namcrs ) 
    8989 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DIA/dia25h.F90

    r10641 r11348  
    5555      REWIND ( numnam_ref )              ! Read Namelist nam_dia25h in reference namelist : 25hour mean diagnostics 
    5656      READ   ( numnam_ref, nam_dia25h, IOSTAT=ios, ERR= 901 ) 
    57 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_dia25h in reference namelist', lwp ) 
     57901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_dia25h in reference namelist' ) 
    5858      REWIND( numnam_cfg )              ! Namelist nam_dia25h in configuration namelist  25hour diagnostics 
    5959      READ  ( numnam_cfg, nam_dia25h, IOSTAT = ios, ERR = 902 ) 
    60 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_dia25h in configuration namelist', lwp ) 
     60902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_dia25h in configuration namelist' ) 
    6161      IF(lwm) WRITE ( numond, nam_dia25h ) 
    6262 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DIA/diadct.F90

    r10425 r11348  
    135135     REWIND( numnam_ref )              ! Namelist namdct in reference namelist : Diagnostic: transport through sections 
    136136     READ  ( numnam_ref, namdct, IOSTAT = ios, ERR = 901) 
    137 901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdct in reference namelist', lwp ) 
     137901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdct in reference namelist' ) 
    138138 
    139139     REWIND( numnam_cfg )              ! Namelist namdct in configuration namelist : Diagnostic: transport through sections 
    140140     READ  ( numnam_cfg, namdct, IOSTAT = ios, ERR = 902 ) 
    141 902  IF( ios >  0 ) CALL ctl_nam ( ios , 'namdct in configuration namelist', lwp ) 
     141902  IF( ios >  0 ) CALL ctl_nam ( ios , 'namdct in configuration namelist' ) 
    142142     IF(lwm) WRITE ( numond, namdct ) 
    143143 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DIA/diaharm.F90

    r10835 r11348  
    8989      REWIND( numnam_ref )              ! Namelist nam_diaharm in reference namelist : Tidal harmonic analysis 
    9090      READ  ( numnam_ref, nam_diaharm, IOSTAT = ios, ERR = 901) 
    91 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_diaharm in reference namelist', lwp ) 
     91901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_diaharm in reference namelist' ) 
    9292      REWIND( numnam_cfg )              ! Namelist nam_diaharm in configuration namelist : Tidal harmonic analysis 
    9393      READ  ( numnam_cfg, nam_diaharm, IOSTAT = ios, ERR = 902 ) 
    94 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist', lwp ) 
     94902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist' ) 
    9595      IF(lwm) WRITE ( numond, nam_diaharm ) 
    9696      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DIA/diahsb.F90

    r10425 r11348  
    362362      REWIND( numnam_ref )              ! Namelist namhsb in reference namelist 
    363363      READ  ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) 
    364 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namhsb in reference namelist', lwp ) 
     364901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namhsb in reference namelist' ) 
    365365      REWIND( numnam_cfg )              ! Namelist namhsb in configuration namelist 
    366366      READ  ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 
    367 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp ) 
     367902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namhsb in configuration namelist' ) 
    368368      IF(lwm) WRITE( numond, namhsb ) 
    369369 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DIA/diaptr.F90

    r10425 r11348  
    393393      REWIND( numnam_ref )              ! Namelist namptr in reference namelist : Poleward transport 
    394394      READ  ( numnam_ref, namptr, IOSTAT = ios, ERR = 901) 
    395 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in reference namelist', lwp ) 
     395901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in reference namelist' ) 
    396396 
    397397      REWIND( numnam_cfg )              ! Namelist namptr in configuration namelist : Poleward transport 
    398398      READ  ( numnam_cfg, namptr, IOSTAT = ios, ERR = 902 ) 
    399 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist', lwp ) 
     399902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist' ) 
    400400      IF(lwm) WRITE ( numond, namptr ) 
    401401 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DIA/diatmb.F90

    r10499 r11348  
    4343      REWIND( numnam_ref )              ! Read Namelist nam_diatmb in reference namelist : TMB diagnostics 
    4444      READ  ( numnam_ref, nam_diatmb, IOSTAT=ios, ERR= 901 ) 
    45 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist', lwp ) 
     45901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist' ) 
    4646  
    4747      REWIND( numnam_cfg )              ! Namelist nam_diatmb in configuration namelist  TMB diagnostics 
    4848      READ  ( numnam_cfg, nam_diatmb, IOSTAT = ios, ERR = 902 ) 
    49 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist', lwp ) 
     49902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist' ) 
    5050      IF(lwm) WRITE ( numond, nam_diatmb ) 
    5151 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DIA/diawri.F90

    r11334 r11348  
    712712         ENDIF 
    713713 
    714          IF( .NOT. ln_cpl ) THEN 
     714         IF( ln_ssr ) THEN 
    715715            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    716716               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     
    720720               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    721721         ENDIF 
    722  
    723          IF( ln_cpl .AND. nn_ice <= 1 ) THEN 
    724             CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    725                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    726             CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    727                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    728             CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
    729                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    730          ENDIF 
    731           
     722        
    732723         clmx ="l_max(only(x))"    ! max index on a period 
    733724         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX  
     
    892883      ENDIF 
    893884 
    894       IF( .NOT. ln_cpl ) THEN 
     885      IF( ln_ssr ) THEN 
    895886         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    896887         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    897          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    898          CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    899       ENDIF 
    900       IF( ln_cpl .AND. nn_ice <= 1 ) THEN 
    901          CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    902          CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    903          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
     888         zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    904889         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    905890      ENDIF 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DIU/diurnal_bulk.F90

    r10069 r11348  
    5454      REWIND( numnam_ref ) 
    5555      READ  ( numnam_ref, namdiu, IOSTAT = ios, ERR = 901 ) 
    56 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdiu in reference namelist', lwp ) 
     56901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdiu in reference namelist' ) 
    5757      REWIND( numnam_cfg ) 
    5858      READ  ( numnam_cfg, namdiu, IOSTAT = ios, ERR = 902 ) 
    59 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdiu in configuration namelist', lwp )       
     59902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdiu in configuration namelist' )       
    6060      ! 
    6161      IF( ln_diurnal_only .AND. ( .NOT. ln_diurnal ) ) THEN 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DOM/domain.F90

    r11258 r11348  
    308308      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run 
    309309      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 
    310 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp ) 
     310901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist' ) 
    311311      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run 
    312312      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) 
    313 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp ) 
     313902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist' ) 
    314314      IF(lwm) WRITE ( numond, namrun ) 
    315315      ! 
     
    401401      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep) 
    402402      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 
    403 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 
     403903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist' ) 
    404404      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 
    405405      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 
    406 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
     406904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' ) 
    407407      IF(lwm) WRITE( numond, namdom ) 
    408408      ! 
     
    433433      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF 
    434434      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 
    435 907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp ) 
     435907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist' ) 
    436436      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF 
    437437      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 ) 
    438 908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp ) 
     438908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namnc4 in configuration namelist' ) 
    439439      IF(lwm) WRITE( numond, namnc4 ) 
    440440 
     
    511511 
    512512 
    513    SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio ) 
     513   SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio ) 
    514514      !!---------------------------------------------------------------------- 
    515515      !!                     ***  ROUTINE dom_nam  *** 
     
    519519      !! ** Method  :   read the cn_domcfg NetCDF file 
    520520      !!---------------------------------------------------------------------- 
    521       CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information 
    522521      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name 
    523522      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution 
     
    525524      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.  
    526525      ! 
    527       INTEGER ::   inum, ii   ! local integer 
     526      INTEGER ::   inum   ! local integer 
    528527      REAL(wp) ::   zorca_res                     ! local scalars 
    529528      REAL(wp) ::   zperio                        !   -      - 
     
    531530      !!---------------------------------------------------------------------- 
    532531      ! 
    533       ii = 1 
    534       WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1 
    535       WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'  ;   ii = ii+1 
    536       WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1 
     532      IF(lwp) THEN 
     533         WRITE(numout,*) '           ' 
     534         WRITE(numout,*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file' 
     535         WRITE(numout,*) '~~~~~~~~~~ ' 
     536      ENDIF 
    537537      ! 
    538538      CALL iom_open( cn_domcfg, inum ) 
     
    545545         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = NINT( zorca_res ) 
    546546         ! 
    547          WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1 
    548          WRITE(ldtxt(ii),*) '   ==>>>   ORCA configuration '                           ;   ii = ii+1 
    549          WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1 
     547         IF(lwp) THEN 
     548            WRITE(numout,*) '   .' 
     549            WRITE(numout,*) '   ==>>>   ORCA configuration ' 
     550            WRITE(numout,*) '   .' 
     551         ENDIF 
    550552         ! 
    551553      ELSE                                !- cd_cfg & k_cfg are not used 
     
    568570      CALL iom_close( inum ) 
    569571      ! 
    570       WRITE(ldtxt(ii),*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1 
    571       WRITE(ldtxt(ii),*) '      jpiglo = ', kpi                                              ;   ii = ii+1 
    572       WRITE(ldtxt(ii),*) '      jpjglo = ', kpj                                              ;   ii = ii+1 
    573       WRITE(ldtxt(ii),*) '      jpkglo = ', kpk                                              ;   ii = ii+1 
    574       WRITE(ldtxt(ii),*) '      type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1 
     572      IF(lwp) THEN 
     573         WRITE(numout,*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg 
     574         WRITE(numout,*) '      jpiglo = ', kpi 
     575         WRITE(numout,*) '      jpjglo = ', kpj 
     576         WRITE(numout,*) '      jpkglo = ', kpk 
     577         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio 
     578      ENDIF 
    575579      !         
    576580   END SUBROUTINE domain_cfg 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DOM/dommsk.F90

    r11263 r11348  
    106106      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition 
    107107      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 ) 
    108 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlbc in reference namelist', lwp ) 
     108901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlbc in reference namelist' ) 
    109109      REWIND( numnam_cfg )              ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition 
    110110      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 ) 
    111 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlbc in configuration namelist', lwp ) 
     111902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlbc in configuration namelist' ) 
    112112      IF(lwm) WRITE ( numond, namlbc ) 
    113113       
     
    151151      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries 
    152152      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 
    153 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
     153903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist' ) 
    154154      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries 
    155155      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 ) 
    156 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
     156904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist' ) 
    157157      ! ------------------------ 
    158158      IF ( ln_bdy .AND. ln_mask_file ) THEN 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DOM/domvvl.F90

    r10425 r11348  
    993993      REWIND( numnam_ref )              ! Namelist nam_vvl in reference namelist :  
    994994      READ  ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901) 
    995 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_vvl in reference namelist', lwp ) 
     995901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_vvl in reference namelist' ) 
    996996      REWIND( numnam_cfg )              ! Namelist nam_vvl in configuration namelist : Parameters of the run 
    997997      READ  ( numnam_cfg, nam_vvl, IOSTAT = ios, ERR = 902 ) 
    998 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_vvl in configuration namelist', lwp ) 
     998902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_vvl in configuration namelist' ) 
    999999      IF(lwm) WRITE ( numond, nam_vvl ) 
    10001000      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DOM/dtatsd.F90

    r10213 r11348  
    6767      REWIND( numnam_ref )              ! Namelist namtsd in reference namelist :  
    6868      READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901) 
    69 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtsd in reference namelist', lwp ) 
     69901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtsd in reference namelist' ) 
    7070      REWIND( numnam_cfg )              ! Namelist namtsd in configuration namelist : Parameters of the run 
    7171      READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 ) 
    72 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtsd in configuration namelist', lwp ) 
     72902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtsd in configuration namelist' ) 
    7373      IF(lwm) WRITE ( numond, namtsd ) 
    7474 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DOM/iscplhsb.F90

    r10425 r11348  
    186186!      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.) 
    187187!      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.) 
    188       STOP ' iscpl_cons:   please modify this module !' 
     188      CALL ctl_stop( 'STOP', ' iscpl_cons:   please modify this MODULE !' ) 
    189189!!gm end 
    190190      ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point  
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DOM/iscplini.F90

    r10425 r11348  
    6464      REWIND( numnam_ref )              ! Namelist namsbc_iscpl in reference namelist : Ice sheet coupling 
    6565      READ  ( numnam_ref, namsbc_iscpl, IOSTAT = ios, ERR = 901) 
    66 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_iscpl in reference namelist', lwp ) 
     66901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_iscpl in reference namelist' ) 
    6767      REWIND( numnam_cfg )              ! Namelist namsbc_iscpl in configuration namelist : Ice Sheet coupling 
    6868      READ  ( numnam_cfg, namsbc_iscpl, IOSTAT = ios, ERR = 902 ) 
    69 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_iscpl in configuration namelist', lwp ) 
     69902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_iscpl in configuration namelist' ) 
    7070      IF(lwm) WRITE ( numond, namsbc_iscpl ) 
    7171      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DYN/dynadv.F90

    r10068 r11348  
    106106      REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme 
    107107      READ  ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901) 
    108 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp ) 
     108901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist' ) 
    109109      REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme 
    110110      READ  ( numnam_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 ) 
    111 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp ) 
     111902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist' ) 
    112112      IF(lwm) WRITE ( numond, namdyn_adv ) 
    113113 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DYN/dynhpg.F90

    r10491 r11348  
    152152      REWIND( numnam_ref )              ! Namelist namdyn_hpg in reference namelist : Hydrostatic pressure gradient 
    153153      READ  ( numnam_ref, namdyn_hpg, IOSTAT = ios, ERR = 901) 
    154 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist', lwp ) 
     154901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist' ) 
    155155      ! 
    156156      REWIND( numnam_cfg )              ! Namelist namdyn_hpg in configuration namelist : Hydrostatic pressure gradient 
    157157      READ  ( numnam_cfg, namdyn_hpg, IOSTAT = ios, ERR = 902 ) 
    158 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist', lwp ) 
     158902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist' ) 
    159159      IF(lwm) WRITE ( numond, namdyn_hpg ) 
    160160      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DYN/dynspg.F90

    r10068 r11348  
    202202      REWIND( numnam_ref )              ! Namelist namdyn_spg in reference namelist : Free surface 
    203203      READ  ( numnam_ref, namdyn_spg, IOSTAT = ios, ERR = 901) 
    204 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_spg in reference namelist', lwp ) 
     204901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_spg in reference namelist' ) 
    205205      ! 
    206206      REWIND( numnam_cfg )              ! Namelist namdyn_spg in configuration namelist : Free surface 
    207207      READ  ( numnam_cfg, namdyn_spg, IOSTAT = ios, ERR = 902 ) 
    208 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist', lwp ) 
     208902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist' ) 
    209209      IF(lwm) WRITE ( numond, namdyn_spg ) 
    210210      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DYN/dynspg_ts.F90

    r11265 r11348  
    250250      zhV(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:)        ! NB: FULL domain : put a value in last row and column 
    251251      ! 
    252       CALL dyn_cor_2d( ht_n, hu_n, hv_n, un_b, vn_b, zhU, zhV,  &   ! <<== in 
    253          &                                     zu_trd, zv_trd   )   ! ==>> out 
     252      CALL dyn_cor_2d( hu_n, hv_n, un_b, vn_b, zhU, zhV,  &   ! <<== in 
     253         &                               zu_trd, zv_trd   )   ! ==>> out 
    254254      ! 
    255255      IF( .NOT.ln_linssh ) THEN                 !* surface pressure gradient   (variable volume only) 
     
    468468               END DO 
    469469            END DO 
    470             DO jj = 1, jpj        ! not jpj-row 
    471                DO ji = 1, jpim1 
     470            DO jj = 1, jpjm1        ! not jpj-row 
     471               DO ji = 1, jpi 
    472472                  zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        & 
    473473                       &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
     
    595595         ! at each time step. We however keep them constant here for optimization. 
    596596         ! Recall that zhU and zhV hold fluxes at jn+0.5 (extrapolated not backward interpolated) 
    597          CALL dyn_cor_2d( zhtp2_e, zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV,    zu_trd, zv_trd   ) 
     597         CALL dyn_cor_2d( zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV,    zu_trd, zv_trd   ) 
    598598         ! 
    599599         ! Add tidal astronomical forcing if defined 
     
    12371237 
    12381238 
    1239    SUBROUTINE dyn_cor_2d( ht_n, hu_n, hv_n, un_b, vn_b, zhU, zhV,    zu_trd, zv_trd   ) 
     1239   SUBROUTINE dyn_cor_2d( hu_n, hv_n, un_b, vn_b, zhU, zhV,    zu_trd, zv_trd   ) 
    12401240      !!--------------------------------------------------------------------- 
    12411241      !!                   ***  ROUTINE dyn_cor_2d  *** 
     
    12431243      !! ** Purpose : Compute u and v coriolis trends 
    12441244      !!---------------------------------------------------------------------- 
    1245       INTEGER  ::   ji ,jj               ! dummy loop indices 
    1246       REAL(wp) ::   zx1, zx2, zy1, zy2   !   -      - 
    1247       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: ht_n, hu_n, hv_n, un_b, vn_b, zhU, zhV 
     1245      INTEGER  ::   ji ,jj                             ! dummy loop indices 
     1246      REAL(wp) ::   zx1, zx2, zy1, zy2, z1_hu, z1_hv   !   -      - 
     1247      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: hu_n, hv_n, un_b, vn_b, zhU, zhV 
    12481248      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: zu_trd, zv_trd 
    12491249      !!---------------------------------------------------------------------- 
     
    12521252         DO jj = 2, jpjm1 
    12531253            DO ji = 2, jpim1 
    1254                zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * r1_hu_n(ji,jj)                    & 
     1254               z1_hu = ssumask(ji,jj) / ( hu_n(ji,jj) + 1._wp - ssumask(ji,jj) ) 
     1255               z1_hv = ssvmask(ji,jj) / ( hv_n(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
     1256               zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu                    & 
    12551257                  &               * (  e1e2t(ji+1,jj)*ht_n(ji+1,jj)*ff_t(ji+1,jj) * ( vn_b(ji+1,jj) + vn_b(ji+1,jj-1) )   & 
    12561258                  &                  + e1e2t(ji  ,jj)*ht_n(ji  ,jj)*ff_t(ji  ,jj) * ( vn_b(ji  ,jj) + vn_b(ji  ,jj-1) )   ) 
    12571259                  ! 
    1258                zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * r1_hv_n(ji,jj)                    & 
     1260               zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv                    & 
    12591261                  &               * (  e1e2t(ji,jj+1)*ht_n(ji,jj+1)*ff_t(ji,jj+1) * ( un_b(ji,jj+1) + un_b(ji-1,jj+1) )   &  
    12601262                  &                  + e1e2t(ji,jj  )*ht_n(ji,jj  )*ff_t(ji,jj  ) * ( un_b(ji,jj  ) + un_b(ji-1,jj  ) )   )  
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DYN/dynvor.F90

    r10425 r11348  
    851851      REWIND( numnam_ref )              ! Namelist namdyn_vor in reference namelist : Vorticity scheme options 
    852852      READ  ( numnam_ref, namdyn_vor, IOSTAT = ios, ERR = 901) 
    853 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_vor in reference namelist', lwp ) 
     853901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_vor in reference namelist' ) 
    854854      REWIND( numnam_cfg )              ! Namelist namdyn_vor in configuration namelist : Vorticity scheme options 
    855855      READ  ( numnam_cfg, namdyn_vor, IOSTAT = ios, ERR = 902 ) 
    856 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_vor in configuration namelist', lwp ) 
     856902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_vor in configuration namelist' ) 
    857857      IF(lwm) WRITE ( numond, namdyn_vor ) 
    858858      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DYN/wet_dry.F90

    r10499 r11348  
    8181      REWIND( numnam_ref )              ! Namelist namwad in reference namelist : Parameters for Wetting/Drying 
    8282      READ  ( numnam_ref, namwad, IOSTAT = ios, ERR = 905) 
    83 905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namwad in reference namelist', .TRUE.)  
     83905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namwad in reference namelist' )  
    8484      REWIND( numnam_cfg )              ! Namelist namwad in configuration namelist : Parameters for Wetting/Drying 
    8585      READ  ( numnam_cfg, namwad, IOSTAT = ios, ERR = 906) 
    86 906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namwad in configuration namelist', .TRUE. ) 
     86906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namwad in configuration namelist' ) 
    8787      IF(lwm) WRITE ( numond, namwad ) 
    8888      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/FLO/floats.F90

    r10068 r11348  
    9090      REWIND( numnam_ref )              ! Namelist namflo in reference namelist : Floats 
    9191      READ  ( numnam_ref, namflo, IOSTAT = ios, ERR = 901) 
    92 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namflo in reference namelist', lwp ) 
     92901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namflo in reference namelist' ) 
    9393 
    9494      REWIND( numnam_cfg )              ! Namelist namflo in configuration namelist : Floats 
    9595      READ  ( numnam_cfg, namflo, IOSTAT = ios, ERR = 902 ) 
    96 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namflo in configuration namelist', lwp ) 
     96902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namflo in configuration namelist' ) 
    9797      IF(lwm) WRITE ( numond, namflo ) 
    9898      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/ICB/icbini.F90

    r10702 r11348  
    406406      REWIND( numnam_ref )              ! Namelist namberg in reference namelist : Iceberg parameters 
    407407      READ  ( numnam_ref, namberg, IOSTAT = ios, ERR = 901) 
    408 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namberg in reference namelist', lwp ) 
     408901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namberg in reference namelist' ) 
    409409      REWIND( numnam_cfg )              ! Namelist namberg in configuration namelist : Iceberg parameters 
    410410      READ  ( numnam_cfg, namberg, IOSTAT = ios, ERR = 902 ) 
    411 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namberg in configuration namelist', lwp ) 
     411902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namberg in configuration namelist' ) 
    412412      IF(lwm) WRITE ( numond, namberg ) 
    413413      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/ICB/icblbc.F90

    r10570 r11348  
    278278         CALL mppsend( 12, zwebergs(1), 1, ipe_E, iml_req1) 
    279279         CALL mpprecv( 11, zewbergs(2), 1, ipe_E ) 
    280          IF( l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) 
     280         CALL mpi_wait( iml_req1, iml_stat, iml_err ) 
    281281         ibergs_rcvd_from_e = INT( zewbergs(2) ) 
    282282      CASE(  0 ) 
     
    287287         CALL mpprecv( 11, zewbergs(2), 1, ipe_E ) 
    288288         CALL mpprecv( 12, zwebergs(2), 1, ipe_W ) 
    289          IF( l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 
    290          IF( l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 
     289         CALL mpi_wait( iml_req2, iml_stat, iml_err ) 
     290         CALL mpi_wait( iml_req3, iml_stat, iml_err ) 
    291291         ibergs_rcvd_from_e = INT( zewbergs(2) ) 
    292292         ibergs_rcvd_from_w = INT( zwebergs(2) ) 
     
    295295         CALL mppsend( 11, zewbergs(1), 1, ipe_W, iml_req4) 
    296296         CALL mpprecv( 12, zwebergs(2), 1, ipe_W ) 
    297          IF( l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) 
     297         CALL mpi_wait( iml_req4, iml_stat, iml_err ) 
    298298         ibergs_rcvd_from_w = INT( zwebergs(2) ) 
    299299      END SELECT 
     
    310310            CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e*jp_buffer_width ) 
    311311         ENDIF 
    312          IF( ibergs_to_send_e > 0 .AND. l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) 
     312         IF( ibergs_to_send_e > 0 ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) 
    313313         DO i = 1, ibergs_rcvd_from_e 
    314314            IF( nn_verbose_level >= 4 ) THEN 
     
    329329            CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w*jp_buffer_width ) 
    330330         ENDIF 
    331          IF( ibergs_to_send_w > 0 .AND. l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 
    332          IF( ibergs_to_send_e > 0 .AND. l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 
     331         IF( ibergs_to_send_w > 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 
     332         IF( ibergs_to_send_e > 0 ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 
    333333         DO i = 1, ibergs_rcvd_from_e 
    334334            IF( nn_verbose_level >= 4 ) THEN 
     
    351351            CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w*jp_buffer_width ) 
    352352         ENDIF 
    353          IF( ibergs_to_send_w > 0 .AND. l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) 
     353         IF( ibergs_to_send_w > 0 ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) 
    354354         DO i = 1, ibergs_rcvd_from_w 
    355355            IF( nn_verbose_level >= 4 ) THEN 
     
    409409         CALL mppsend( 16, zsnbergs(1), 1, ipe_N, iml_req1) 
    410410         CALL mpprecv( 15, znsbergs(2), 1, ipe_N ) 
    411          IF( l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) 
     411         CALL mpi_wait( iml_req1, iml_stat, iml_err ) 
    412412         ibergs_rcvd_from_n = INT( znsbergs(2) ) 
    413413      CASE(  0 ) 
     
    418418         CALL mpprecv( 15, znsbergs(2), 1, ipe_N ) 
    419419         CALL mpprecv( 16, zsnbergs(2), 1, ipe_S ) 
    420          IF( l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 
    421          IF( l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 
     420         CALL mpi_wait( iml_req2, iml_stat, iml_err ) 
     421         CALL mpi_wait( iml_req3, iml_stat, iml_err ) 
    422422         ibergs_rcvd_from_n = INT( znsbergs(2) ) 
    423423         ibergs_rcvd_from_s = INT( zsnbergs(2) ) 
     
    426426         CALL mppsend( 15, znsbergs(1), 1, ipe_S, iml_req4) 
    427427         CALL mpprecv( 16, zsnbergs(2), 1, ipe_S ) 
    428          IF( l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) 
     428         CALL mpi_wait( iml_req4, iml_stat, iml_err ) 
    429429         ibergs_rcvd_from_s = INT( zsnbergs(2) ) 
    430430      END SELECT 
     
    441441            CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n*jp_buffer_width ) 
    442442         ENDIF 
    443          IF( ibergs_to_send_n > 0 .AND. l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) 
     443         IF( ibergs_to_send_n > 0 ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) 
    444444         DO i = 1, ibergs_rcvd_from_n 
    445445            IF( nn_verbose_level >= 4 ) THEN 
     
    460460            CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s*jp_buffer_width ) 
    461461         ENDIF 
    462          IF( ibergs_to_send_s > 0 .AND. l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 
    463          IF( ibergs_to_send_n > 0 .AND. l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 
     462         IF( ibergs_to_send_s > 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 
     463         IF( ibergs_to_send_n > 0 ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 
    464464         DO i = 1, ibergs_rcvd_from_n 
    465465            IF( nn_verbose_level >= 4 ) THEN 
     
    482482            CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s*jp_buffer_width ) 
    483483         ENDIF 
    484          IF( ibergs_to_send_s > 0 .AND. l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) 
     484         IF( ibergs_to_send_s > 0 ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) 
    485485         DO i = 1, ibergs_rcvd_from_s 
    486486            IF( nn_verbose_level >= 4 ) THEN 
     
    669669            ifldproc = nicbfldproc(jn) 
    670670            IF( ifldproc == narea ) CYCLE 
    671  
    672             IF( l_isend ) CALL mpi_wait( nicbfldreq(jn), iml_stat, iml_err ) 
     671            CALL mpi_wait( nicbfldreq(jn), iml_stat, iml_err ) 
    673672         ENDIF 
    674673         ! 
     
    770769            ifldproc = nicbfldproc(jn) 
    771770            IF( ifldproc == narea ) CYCLE 
    772  
    773             IF( l_isend ) CALL mpi_wait( nicbfldreq(jn), iml_stat, iml_err ) 
     771            CALL mpi_wait( nicbfldreq(jn), iml_stat, iml_err ) 
    774772         ENDIF 
    775773         ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/IOM/in_out_manager.F90

    r10817 r11348  
    167167   CHARACTER(lc) ::   ctmp7, ctmp8, ctmp9   !: temporary characters 7 to 9 
    168168   CHARACTER(lc) ::   ctmp10                !: temporary character 10 
    169    CHARACTER(lc) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !: 
    170    CHARACTER(lc) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !: 
    171169   LOGICAL       ::   lwm      = .FALSE.    !: boolean : true on the 1st processor only (always) 
    172170   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/LBC/lbc_nfd_nogather_generic.h90

    r10425 r11348  
    7474      ! 
    7575      ! Security check for further developments 
    76       IF ( ipf > 1 ) THEN 
    77         write(6,*) 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation'  
    78         write(6,*) 'You should not be there...'  
    79         STOP 
    80       ENDIF 
     76      IF ( ipf > 1 ) CALL ctl_stop( 'STOP', 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation...' ) 
    8177      ! 
    8278      ijpj   = 1    ! index of first modified line  
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/LBC/lbclnk.F90

    r11195 r11348  
    410410         CALL mppsend( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req1 ) 
    411411         CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea ) 
    412          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     412         CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    413413      CASE ( 0 ) 
    414414         CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 ) 
     
    416416         CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea ) 
    417417         CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe ) 
    418          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    419          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
     418         CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     419         CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    420420      CASE ( 1 ) 
    421421         CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 ) 
    422422         CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe ) 
    423          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     423         CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    424424      END SELECT 
    425425      ! 
     
    467467         CALL mppsend( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req1 ) 
    468468         CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono ) 
    469          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     469         CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    470470      CASE ( 0 ) 
    471471         CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 ) 
     
    473473         CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono ) 
    474474         CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso ) 
    475          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    476          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
     475         CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     476         CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    477477      CASE ( 1 ) 
    478478         CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 ) 
    479479         CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso ) 
    480          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     480         CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    481481      END SELECT 
    482482      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/LBC/lbcnfd.F90

    r10425 r11348  
    2020   USE dom_oce        ! ocean space and time domain  
    2121   USE in_out_manager ! I/O manager 
     22   USE lib_mpp        ! MPP library 
    2223 
    2324   IMPLICIT NONE 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/LBC/lib_mpp.F90

    r11194 r11348  
    3232   !!   ctl_opn       : Open file and check if required file is available. 
    3333   !!   ctl_nam       : Prints informations when an error occurs while reading a namelist 
    34    !!   get_unit      : give the index of an unused logical unit 
    35    !!---------------------------------------------------------------------- 
    36    !!---------------------------------------------------------------------- 
    37    !!   mynode        : indentify the processor unit 
     34   !!---------------------------------------------------------------------- 
     35   !!---------------------------------------------------------------------- 
     36   !!   mpp_start     : get local communicator its size and rank 
    3837   !!   mpp_lnk       : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d) 
    3938   !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb) 
     
    5857   PRIVATE 
    5958   ! 
    60    PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam 
    61    PUBLIC   mynode, mppstop, mppsync, mpp_comm_free 
     59   PUBLIC   ctl_stop, ctl_warn, ctl_opn, ctl_nam 
     60   PUBLIC   mpp_start, mppstop, mppsync, mpp_comm_free 
    6261   PUBLIC   mpp_ini_north 
    6362   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 
     
    131130   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_north   !: dimension ndim_rank_north 
    132131 
    133    ! Type of send : standard, buffered, immediate 
    134    CHARACTER(len=1), PUBLIC ::   cn_mpi_send        !: type od mpi send/recieve (S=standard, B=bsend, I=isend) 
    135    LOGICAL         , PUBLIC ::   l_isend = .FALSE.  !: isend use indicator (T if cn_mpi_send='I') 
    136    INTEGER         , PUBLIC ::   nn_buffer          !: size of the buffer in case of mpi_bsend 
    137  
    138132   ! Communications summary report 
    139133   CHARACTER(len=128), DIMENSION(:), ALLOCATABLE ::   crname_lbc                   !: names of lbc_lnk calling routines 
     
    180174CONTAINS 
    181175 
    182    FUNCTION mynode( ldtxt, ldname, kumnam_ref, kumnam_cfg, kumond, kstop, localComm ) 
    183       !!---------------------------------------------------------------------- 
    184       !!                  ***  routine mynode  *** 
    185       !! 
    186       !! ** Purpose :   Find processor unit 
    187       !!---------------------------------------------------------------------- 
    188       CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt        ! 
    189       CHARACTER(len=*)             , INTENT(in   ) ::   ldname       ! 
    190       INTEGER                      , INTENT(in   ) ::   kumnam_ref   ! logical unit for reference namelist 
    191       INTEGER                      , INTENT(in   ) ::   kumnam_cfg   ! logical unit for configuration namelist 
    192       INTEGER                      , INTENT(inout) ::   kumond       ! logical unit for namelist output 
    193       INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator 
     176   SUBROUTINE mpp_start( localComm ) 
     177      !!---------------------------------------------------------------------- 
     178      !!                  ***  routine mpp_start  *** 
     179      !! 
     180      !! ** Purpose :   get mpi_comm_oce, mpprank and mppsize 
     181      !!---------------------------------------------------------------------- 
    194182      INTEGER         , OPTIONAL   , INTENT(in   ) ::   localComm    ! 
    195183      ! 
    196       INTEGER ::   mynode, ierr, code, ji, ii, ios 
    197       LOGICAL ::   mpi_was_called 
    198       ! 
    199       NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, ln_nnogather 
    200       !!---------------------------------------------------------------------- 
    201 #if defined key_mpp_mpi 
    202       ! 
    203       ii = 1 
    204       WRITE(ldtxt(ii),*)                                                                  ;   ii = ii + 1 
    205       WRITE(ldtxt(ii),*) 'mynode : mpi initialisation'                                    ;   ii = ii + 1 
    206       WRITE(ldtxt(ii),*) '~~~~~~ '                                                        ;   ii = ii + 1 
    207       ! 
    208       REWIND( kumnam_ref )              ! Namelist nammpp in reference namelist: mpi variables 
    209       READ  ( kumnam_ref, nammpp, IOSTAT = ios, ERR = 901) 
    210 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp ) 
    211       ! 
    212       REWIND( kumnam_cfg )              ! Namelist nammpp in configuration namelist: mpi variables 
    213       READ  ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 ) 
    214 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp ) 
    215       ! 
    216       !                              ! control print 
    217       WRITE(ldtxt(ii),*) '   Namelist nammpp'                                             ;   ii = ii + 1 
    218       WRITE(ldtxt(ii),*) '      mpi send type          cn_mpi_send = ', cn_mpi_send       ;   ii = ii + 1 
    219       WRITE(ldtxt(ii),*) '      size exported buffer   nn_buffer   = ', nn_buffer,' bytes';   ii = ii + 1 
    220       ! 
    221       IF( jpni < 1 .OR. jpnj < 1  ) THEN 
    222          WRITE(ldtxt(ii),*) '      jpni and jpnj will be calculated automatically' ;   ii = ii + 1 
    223       ELSE 
    224          WRITE(ldtxt(ii),*) '      processor grid extent in i         jpni = ',jpni       ;   ii = ii + 1 
    225          WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj       ;   ii = ii + 1 
    226       ENDIF 
    227  
    228       WRITE(ldtxt(ii),*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather  ; ii = ii + 1 
    229  
    230       CALL mpi_initialized ( mpi_was_called, code ) 
    231       IF( code /= MPI_SUCCESS ) THEN 
    232          DO ji = 1, SIZE(ldtxt) 
    233             IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    234          END DO 
    235          WRITE(*, cform_err) 
    236          WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
    237          CALL mpi_abort( mpi_comm_world, code, ierr ) 
    238       ENDIF 
    239  
    240       IF( mpi_was_called ) THEN 
    241          ! 
    242          SELECT CASE ( cn_mpi_send ) 
    243          CASE ( 'S' )                ! Standard mpi send (blocking) 
    244             WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1 
    245          CASE ( 'B' )                ! Buffer mpi send (blocking) 
    246             WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'              ;   ii = ii + 1 
    247             IF( Agrif_Root() )   CALL mpi_init_oce( ldtxt, ii, ierr ) 
    248          CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    249             WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'           ;   ii = ii + 1 
    250             l_isend = .TRUE. 
    251          CASE DEFAULT 
    252             WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1 
    253             WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1 
    254             kstop = kstop + 1 
    255          END SELECT 
    256          ! 
    257       ELSEIF ( PRESENT(localComm) .AND. .NOT. mpi_was_called ) THEN 
    258          WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1 
    259          WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1 
    260          WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1 
    261          kstop = kstop + 1 
    262       ELSE 
    263          SELECT CASE ( cn_mpi_send ) 
    264          CASE ( 'S' )                ! Standard mpi send (blocking) 
    265             WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1 
    266             CALL mpi_init( ierr ) 
    267          CASE ( 'B' )                ! Buffer mpi send (blocking) 
    268             WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'              ;   ii = ii + 1 
    269             IF( Agrif_Root() )   CALL mpi_init_oce( ldtxt, ii, ierr ) 
    270          CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    271             WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'           ;   ii = ii + 1 
    272             l_isend = .TRUE. 
    273             CALL mpi_init( ierr ) 
    274          CASE DEFAULT 
    275             WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1 
    276             WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1 
    277             kstop = kstop + 1 
    278          END SELECT 
    279          ! 
    280       ENDIF 
    281  
     184      INTEGER ::   ierr 
     185      LOGICAL ::   llmpi_init 
     186      !!---------------------------------------------------------------------- 
     187#if defined key_mpp_mpi 
     188      ! 
     189      CALL mpi_initialized ( llmpi_init, ierr ) 
     190      IF( ierr /= MPI_SUCCESS ) CALL ctl_stop( 'STOP', ' lib_mpp: Error in routine mpi_initialized' ) 
     191 
     192      IF( .NOT. llmpi_init ) THEN 
     193         IF( PRESENT(localComm) ) THEN 
     194            WRITE(ctmp1,*) ' lib_mpp: You cannot provide a local communicator ' 
     195            WRITE(ctmp2,*) '          without calling MPI_Init before ! ' 
     196            CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
     197         ENDIF 
     198         CALL mpi_init( ierr ) 
     199         IF( ierr /= MPI_SUCCESS ) CALL ctl_stop( 'STOP', ' lib_mpp: Error in routine mpi_init' ) 
     200      ENDIF 
     201        
    282202      IF( PRESENT(localComm) ) THEN 
    283203         IF( Agrif_Root() ) THEN 
     
    285205         ENDIF 
    286206      ELSE 
    287          CALL mpi_comm_dup( mpi_comm_world, mpi_comm_oce, code) 
    288          IF( code /= MPI_SUCCESS ) THEN 
    289             DO ji = 1, SIZE(ldtxt) 
    290                IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    291             END DO 
    292             WRITE(*, cform_err) 
    293             WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
    294             CALL mpi_abort( mpi_comm_world, code, ierr ) 
    295          ENDIF 
     207         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_oce, ierr) 
     208         IF( ierr /= MPI_SUCCESS ) CALL ctl_stop( 'STOP', ' lib_mpp: Error in routine mpi_comm_dup' ) 
    296209      ENDIF 
    297210 
     
    306219      CALL mpi_comm_rank( mpi_comm_oce, mpprank, ierr ) 
    307220      CALL mpi_comm_size( mpi_comm_oce, mppsize, ierr ) 
    308       mynode = mpprank 
    309  
    310       IF( mynode == 0 ) THEN 
    311          CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
    312          WRITE(kumond, nammpp)       
    313       ENDIF 
    314221      ! 
    315222      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr) 
     
    317224#else 
    318225      IF( PRESENT( localComm ) ) mpi_comm_oce = localComm 
    319       mynode = 0 
    320       CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
    321 #endif 
    322    END FUNCTION mynode 
     226      mppsize = 1 
     227      mpprank = 0 
     228#endif 
     229   END SUBROUTINE mpp_start 
    323230 
    324231 
     
    340247      ! 
    341248#if defined key_mpp_mpi 
    342       SELECT CASE ( cn_mpi_send ) 
    343       CASE ( 'S' )                ! Standard mpi send (blocking) 
    344          CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce        , iflag ) 
    345       CASE ( 'B' )                ! Buffer mpi send (blocking) 
    346          CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce        , iflag ) 
    347       CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    348          ! be carefull, one more argument here : the mpi request identifier.. 
    349          CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce, md_req, iflag ) 
    350       END SELECT 
     249      CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce, md_req, iflag ) 
    351250#endif 
    352251      ! 
     
    836735      ! 
    837736      ALLOCATE( kwork(jpnij), STAT=ierr ) 
    838       IF( ierr /= 0 ) THEN 
    839          WRITE(kumout, cform_err) 
    840          WRITE(kumout,*) 'mpp_ini_znl : failed to allocate 1D array of length jpnij' 
    841          CALL mppstop 
    842       ENDIF 
     737      IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'mpp_ini_znl : failed to allocate 1D array of length jpnij') 
    843738 
    844739      IF( jpnj == 1 ) THEN 
     
    968863#endif 
    969864   END SUBROUTINE mpp_ini_north 
    970  
    971  
    972    SUBROUTINE mpi_init_oce( ldtxt, ksft, code ) 
    973       !!--------------------------------------------------------------------- 
    974       !!                   ***  routine mpp_init.opa  *** 
    975       !! 
    976       !! ** Purpose :: export and attach a MPI buffer for bsend 
    977       !! 
    978       !! ** Method  :: define buffer size in namelist, if 0 no buffer attachment 
    979       !!            but classical mpi_init 
    980       !! 
    981       !! History :: 01/11 :: IDRIS initial version for IBM only 
    982       !!            08/04 :: R. Benshila, generalisation 
    983       !!--------------------------------------------------------------------- 
    984       CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
    985       INTEGER                      , INTENT(inout) ::   ksft 
    986       INTEGER                      , INTENT(  out) ::   code 
    987       INTEGER                                      ::   ierr, ji 
    988       LOGICAL                                      ::   mpi_was_called 
    989       !!--------------------------------------------------------------------- 
    990 #if defined key_mpp_mpi 
    991       ! 
    992       CALL mpi_initialized( mpi_was_called, code )      ! MPI initialization 
    993       IF ( code /= MPI_SUCCESS ) THEN 
    994          DO ji = 1, SIZE(ldtxt) 
    995             IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    996          END DO 
    997          WRITE(*, cform_err) 
    998          WRITE(*, *) ' lib_mpp: Error in routine mpi_initialized' 
    999          CALL mpi_abort( mpi_comm_world, code, ierr ) 
    1000       ENDIF 
    1001       ! 
    1002       IF( .NOT. mpi_was_called ) THEN 
    1003          CALL mpi_init( code ) 
    1004          CALL mpi_comm_dup( mpi_comm_world, mpi_comm_oce, code ) 
    1005          IF ( code /= MPI_SUCCESS ) THEN 
    1006             DO ji = 1, SIZE(ldtxt) 
    1007                IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    1008             END DO 
    1009             WRITE(*, cform_err) 
    1010             WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
    1011             CALL mpi_abort( mpi_comm_world, code, ierr ) 
    1012          ENDIF 
    1013       ENDIF 
    1014       ! 
    1015       IF( nn_buffer > 0 ) THEN 
    1016          WRITE(ldtxt(ksft),*) 'mpi_bsend, buffer allocation of  : ', nn_buffer   ;   ksft = ksft + 1 
    1017          ! Buffer allocation and attachment 
    1018          ALLOCATE( tampon(nn_buffer), stat = ierr ) 
    1019          IF( ierr /= 0 ) THEN 
    1020             DO ji = 1, SIZE(ldtxt) 
    1021                IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    1022             END DO 
    1023             WRITE(*, cform_err) 
    1024             WRITE(*, *) ' lib_mpp: Error in ALLOCATE', ierr 
    1025             CALL mpi_abort( mpi_comm_world, code, ierr ) 
    1026          END IF 
    1027          CALL mpi_buffer_attach( tampon, nn_buffer, code ) 
    1028       ENDIF 
    1029       ! 
    1030 #endif 
    1031    END SUBROUTINE mpi_init_oce 
    1032865 
    1033866 
     
    12401073      !!                increment the error number (nstop) by one. 
    12411074      !!---------------------------------------------------------------------- 
    1242       CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5 
    1243       CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10 
     1075      CHARACTER(len=*), INTENT(in   )           ::   cd1 
     1076      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::        cd2, cd3, cd4, cd5 
     1077      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::   cd6, cd7, cd8, cd9, cd10 
    12441078      !!---------------------------------------------------------------------- 
    12451079      ! 
    12461080      nstop = nstop + 1 
    1247  
    1248       ! force to open ocean.output file 
     1081      ! 
     1082      ! force to open ocean.output file if not already opened 
    12491083      IF( numout == 6 ) CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    1250         
    1251       WRITE(numout,cform_err) 
    1252       IF( PRESENT(cd1 ) )   WRITE(numout,*) TRIM(cd1) 
     1084      ! 
     1085                            WRITE(numout,*) 
     1086                            WRITE(numout,*) ' ===>>> : E R R O R' 
     1087                            WRITE(numout,*) 
     1088                            WRITE(numout,*) '         ===========' 
     1089                            WRITE(numout,*) 
     1090                            WRITE(numout,*) TRIM(cd1) 
    12531091      IF( PRESENT(cd2 ) )   WRITE(numout,*) TRIM(cd2) 
    12541092      IF( PRESENT(cd3 ) )   WRITE(numout,*) TRIM(cd3) 
     
    12601098      IF( PRESENT(cd9 ) )   WRITE(numout,*) TRIM(cd9) 
    12611099      IF( PRESENT(cd10) )   WRITE(numout,*) TRIM(cd10) 
    1262  
     1100                            WRITE(numout,*) 
     1101      ! 
    12631102                               CALL FLUSH(numout    ) 
    12641103      IF( numstp     /= -1 )   CALL FLUSH(numstp    ) 
     
    12671106      ! 
    12681107      IF( cd1 == 'STOP' ) THEN 
     1108         WRITE(numout,*)   
    12691109         WRITE(numout,*)  'huge E-R-R-O-R : immediate stop' 
    1270          CALL mppstop(ld_force_abort = .true.) 
     1110         WRITE(numout,*)   
     1111         CALL mppstop( ld_force_abort = .true. ) 
    12711112      ENDIF 
    12721113      ! 
     
    12871128      ! 
    12881129      nwarn = nwarn + 1 
     1130      ! 
    12891131      IF(lwp) THEN 
    1290          WRITE(numout,cform_war) 
    1291          IF( PRESENT(cd1 ) ) WRITE(numout,*) TRIM(cd1) 
    1292          IF( PRESENT(cd2 ) ) WRITE(numout,*) TRIM(cd2) 
    1293          IF( PRESENT(cd3 ) ) WRITE(numout,*) TRIM(cd3) 
    1294          IF( PRESENT(cd4 ) ) WRITE(numout,*) TRIM(cd4) 
    1295          IF( PRESENT(cd5 ) ) WRITE(numout,*) TRIM(cd5) 
    1296          IF( PRESENT(cd6 ) ) WRITE(numout,*) TRIM(cd6) 
    1297          IF( PRESENT(cd7 ) ) WRITE(numout,*) TRIM(cd7) 
    1298          IF( PRESENT(cd8 ) ) WRITE(numout,*) TRIM(cd8) 
    1299          IF( PRESENT(cd9 ) ) WRITE(numout,*) TRIM(cd9) 
    1300          IF( PRESENT(cd10) ) WRITE(numout,*) TRIM(cd10) 
     1132                               WRITE(numout,*) 
     1133                               WRITE(numout,*) ' ===>>> : W A R N I N G' 
     1134                               WRITE(numout,*) 
     1135                               WRITE(numout,*) '         ===============' 
     1136                               WRITE(numout,*) 
     1137         IF( PRESENT(cd1 ) )   WRITE(numout,*) TRIM(cd1) 
     1138         IF( PRESENT(cd2 ) )   WRITE(numout,*) TRIM(cd2) 
     1139         IF( PRESENT(cd3 ) )   WRITE(numout,*) TRIM(cd3) 
     1140         IF( PRESENT(cd4 ) )   WRITE(numout,*) TRIM(cd4) 
     1141         IF( PRESENT(cd5 ) )   WRITE(numout,*) TRIM(cd5) 
     1142         IF( PRESENT(cd6 ) )   WRITE(numout,*) TRIM(cd6) 
     1143         IF( PRESENT(cd7 ) )   WRITE(numout,*) TRIM(cd7) 
     1144         IF( PRESENT(cd8 ) )   WRITE(numout,*) TRIM(cd8) 
     1145         IF( PRESENT(cd9 ) )   WRITE(numout,*) TRIM(cd9) 
     1146         IF( PRESENT(cd10) )   WRITE(numout,*) TRIM(cd10) 
     1147                               WRITE(numout,*) 
    13011148      ENDIF 
    13021149      CALL FLUSH(numout) 
     
    13411188      IF( TRIM(cdfile) == '/dev/null' )   clfile = TRIM(cdfile)   ! force the use of /dev/null 
    13421189      ! 
    1343       iost=0 
    1344       IF( cdacce(1:6) == 'DIRECT' )  THEN         ! cdacce has always more than 6 characters 
     1190      IF(       cdacce(1:6) == 'DIRECT' )  THEN   ! cdacce has always more than 6 characters 
    13451191         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh         , ERR=100, IOSTAT=iost ) 
    13461192      ELSE IF( TRIM(cdstat) == 'APPEND' )  THEN   ! cdstat can have less than 6 characters 
     
    13631209100   CONTINUE 
    13641210      IF( iost /= 0 ) THEN 
    1365          IF(ldwp) THEN 
    1366             WRITE(kout,*) 
    1367             WRITE(kout,*) ' ===>>>> : bad opening file: ', TRIM(clfile) 
    1368             WRITE(kout,*) ' =======   ===  ' 
    1369             WRITE(kout,*) '           unit   = ', knum 
    1370             WRITE(kout,*) '           status = ', cdstat 
    1371             WRITE(kout,*) '           form   = ', cdform 
    1372             WRITE(kout,*) '           access = ', cdacce 
    1373             WRITE(kout,*) '           iostat = ', iost 
    1374             WRITE(kout,*) '           we stop. verify the file ' 
    1375             WRITE(kout,*) 
    1376          ELSE  !!! Force writing to make sure we get the information - at least once - in this violent STOP!! 
    1377             WRITE(*,*) 
    1378             WRITE(*,*) ' ===>>>> : bad opening file: ', TRIM(clfile) 
    1379             WRITE(*,*) ' =======   ===  ' 
    1380             WRITE(*,*) '           unit   = ', knum 
    1381             WRITE(*,*) '           status = ', cdstat 
    1382             WRITE(*,*) '           form   = ', cdform 
    1383             WRITE(*,*) '           access = ', cdacce 
    1384             WRITE(*,*) '           iostat = ', iost 
    1385             WRITE(*,*) '           we stop. verify the file ' 
    1386             WRITE(*,*) 
    1387          ENDIF 
    1388          CALL FLUSH( kout )  
    1389          STOP 'ctl_opn bad opening' 
     1211         WRITE(ctmp1,*) ' ===>>>> : bad opening file: ', TRIM(clfile) 
     1212         WRITE(ctmp2,*) ' =======   ===  ' 
     1213         WRITE(ctmp3,*) '           unit   = ', knum 
     1214         WRITE(ctmp4,*) '           status = ', cdstat 
     1215         WRITE(ctmp5,*) '           form   = ', cdform 
     1216         WRITE(ctmp6,*) '           access = ', cdacce 
     1217         WRITE(ctmp7,*) '           iostat = ', iost 
     1218         WRITE(ctmp8,*) '           we stop. verify the file ' 
     1219         CALL ctl_stop( 'STOP', ctmp1, ctmp2, ctmp3, ctmp4, ctmp5, ctmp6, ctmp7, ctmp8 ) 
    13901220      ENDIF 
    13911221      ! 
     
    13931223 
    13941224 
    1395    SUBROUTINE ctl_nam ( kios, cdnam, ldwp ) 
     1225   SUBROUTINE ctl_nam ( kios, cdnam ) 
    13961226      !!---------------------------------------------------------------------- 
    13971227      !!                  ***  ROUTINE ctl_nam  *** 
     
    14011231      !! ** Method  :   Fortan open 
    14021232      !!---------------------------------------------------------------------- 
    1403       INTEGER         , INTENT(inout) ::   kios    ! IO status after reading the namelist 
    1404       CHARACTER(len=*), INTENT(in   ) ::   cdnam   ! group name of namelist for which error occurs 
    1405       CHARACTER(len=5)                ::   clios   ! string to convert iostat in character for print 
    1406       LOGICAL         , INTENT(in   ) ::   ldwp    ! boolean term for print 
     1233      INTEGER                                , INTENT(inout) ::   kios    ! IO status after reading the namelist 
     1234      CHARACTER(len=*)                       , INTENT(in   ) ::   cdnam   ! group name of namelist for which error occurs 
     1235      ! 
     1236      CHARACTER(len=5) ::   clios   ! string to convert iostat in character for print 
    14071237      !!---------------------------------------------------------------------- 
    14081238      ! 
     
    14181248      ENDIF 
    14191249      kios = 0 
    1420       RETURN 
    14211250      ! 
    14221251   END SUBROUTINE ctl_nam 
     
    14391268      END DO 
    14401269      IF( (get_unit == 999) .AND. llopn ) THEN 
    1441          CALL ctl_stop( 'get_unit: All logical units until 999 are used...' ) 
    1442          get_unit = -1 
     1270         CALL ctl_stop( 'STOP', 'get_unit: All logical units until 999 are used...' ) 
    14431271      ENDIF 
    14441272      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/LBC/mpp_nfd_generic.h90

    r10440 r11348  
    7676      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers) 
    7777      ! 
    78       IF( l_north_nogather ) THEN      !==  ????  ==! 
     78      IF( l_north_nogather ) THEN      !==  no allgather exchanges  ==! 
    7979 
    8080         ALLOCATE(ipj_s(ipf)) 
     
    200200            ENDIF 
    201201         END DO 
    202          IF( l_isend ) THEN 
    203             DO jr = 1,nsndto 
    204                IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN 
    205                   CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err ) 
    206                ENDIF 
    207             END DO 
    208          ENDIF 
     202         DO jr = 1,nsndto 
     203            IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN 
     204               CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err ) 
     205            ENDIF 
     206         END DO 
    209207         ! 
    210208         IF( ln_timing ) CALL tic_tac(.FALSE.) 
     
    213211         ! 
    214212         DO jf = 1, ipf 
    215             CALL lbc_nfd_nogather(ARRAY_IN(:,:,:,:,jf), ztabr(:,1:ipj_s(jf),:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG ) 
    216          END DO 
    217          ! 
    218          DEALLOCATE( zfoldwk ) 
    219          DEALLOCATE( ztabr )  
    220          DEALLOCATE( jj_s )  
    221          DEALLOCATE( ipj_s )  
    222       ELSE                             !==  ????  ==! 
     213            CALL lbc_nfd_nogather( ARRAY_IN(:,:,:,:,jf), ztabr(:,1:ipj_s(jf),:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG ) 
     214         END DO 
     215         ! 
     216         DEALLOCATE( zfoldwk, ztabr, jj_s, ipj_s ) 
     217         ! 
     218      ELSE                             !==  allgather exchanges  ==! 
    223219         ! 
    224220         ipj   = 4            ! 2nd dimension of message transfers (last j-lines) 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/LBC/mppini.F90

    r11263 r11348  
    168168           &             rn_ice_tem, rn_ice_sal, rn_ice_age,                     & 
    169169           &             ln_vol, nn_volctl, nn_rimwidth 
    170       !!---------------------------------------------------------------------- 
    171  
     170      NAMELIST/nammpp/ jpni, jpnj, ln_nnogather 
     171      !!---------------------------------------------------------------------- 
     172      ! 
    172173      llwrtlay = lwp .OR. ln_ctl .OR. sn_cfctl%l_layout 
     174      ! 
     175      !  0. read namelists parameters 
     176      ! ----------------------------------- 
     177      ! 
     178      REWIND( numnam_ref )              ! Namelist nammpp in reference namelist 
     179      READ  ( numnam_ref, nammpp, IOSTAT = ios, ERR = 901 ) 
     180901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nammpp in reference namelist' ) 
     181      REWIND( numnam_cfg )              ! Namelist nammpp in confguration namelist 
     182      READ  ( numnam_cfg, nammpp, IOSTAT = ios, ERR = 902 ) 
     183902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist' )    
     184      ! 
     185      IF(lwp) THEN 
     186            WRITE(numout,*) '   Namelist nammpp' 
     187         IF( jpni < 1 .OR. jpnj < 1  ) THEN 
     188            WRITE(numout,*) '      jpni and jpnj will be calculated automatically' 
     189         ELSE 
     190            WRITE(numout,*) '      processor grid extent in i                            jpni = ', jpni 
     191            WRITE(numout,*) '      processor grid extent in j                            jpnj = ', jpnj 
     192         ENDIF 
     193            WRITE(numout,*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather 
     194      ENDIF 
     195      ! 
     196      IF(lwm)   WRITE( numond, nammpp ) 
     197 
    173198      ! do we need to take into account bdy_msk? 
    174199      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist : BDY 
    175200      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 
    176 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)', lwp ) 
     201903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)' ) 
    177202      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist : BDY 
    178203      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 ) 
    179 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)', lwp ) 
     204904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)' ) 
    180205      ! 
    181206      IF(               ln_read_cfg ) CALL iom_open( cn_domcfg,    numbot ) 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/LDF/ldfdyn.F90

    r10784 r11348  
    117117      REWIND( numnam_ref )              ! Namelist namdyn_ldf in reference namelist : Lateral physics 
    118118      READ  ( numnam_ref, namdyn_ldf, IOSTAT = ios, ERR = 901) 
    119 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_ldf in reference namelist', lwp ) 
     119901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_ldf in reference namelist' ) 
    120120 
    121121      REWIND( numnam_cfg )              ! Namelist namdyn_ldf in configuration namelist : Lateral physics 
    122122      READ  ( numnam_cfg, namdyn_ldf, IOSTAT = ios, ERR = 902 ) 
    123 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_ldf in configuration namelist', lwp ) 
     123902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_ldf in configuration namelist' ) 
    124124      IF(lwm) WRITE ( numond, namdyn_ldf ) 
    125125 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/LDF/ldftra.F90

    r10425 r11348  
    154154      REWIND( numnam_ref )              ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers 
    155155      READ  ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901) 
    156 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp ) 
     156901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_ldf in reference namelist' ) 
    157157      REWIND( numnam_cfg )              ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers 
    158158      READ  ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 ) 
    159 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp ) 
     159902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist' ) 
    160160      IF(lwm) WRITE( numond, namtra_ldf ) 
    161161      ! 
     
    512512      REWIND( numnam_ref )              ! Namelist namtra_eiv in reference namelist : eddy induced velocity param. 
    513513      READ  ( numnam_ref, namtra_eiv, IOSTAT = ios, ERR = 901) 
    514 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_eiv in reference namelist', lwp ) 
     514901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_eiv in reference namelist' ) 
    515515      ! 
    516516      REWIND( numnam_cfg )              ! Namelist namtra_eiv in configuration namelist : eddy induced velocity param. 
    517517      READ  ( numnam_cfg, namtra_eiv, IOSTAT = ios, ERR = 902 ) 
    518 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_eiv in configuration namelist', lwp ) 
     518902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_eiv in configuration namelist' ) 
    519519      IF(lwm)  WRITE ( numond, namtra_eiv ) 
    520520 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/OBS/diaobs.F90

    r10068 r11348  
    203203      REWIND( numnam_ref )   ! Namelist namobs in reference namelist 
    204204      READ  ( numnam_ref, namobs, IOSTAT = ios, ERR = 901) 
    205 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namobs in reference namelist', lwp ) 
     205901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namobs in reference namelist' ) 
    206206      REWIND( numnam_cfg )   ! Namelist namobs in configuration namelist 
    207207      READ  ( numnam_cfg, namobs, IOSTAT = ios, ERR = 902 ) 
    208 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namobs in configuration namelist', lwp ) 
     208902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namobs in configuration namelist' ) 
    209209      IF(lwm) WRITE ( numond, namobs ) 
    210210 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcapr.F90

    r11263 r11348  
    7171      REWIND( numnam_ref )              ! Namelist namsbc_apr in reference namelist : File for atmospheric pressure forcing 
    7272      READ  ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901) 
    73 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_apr in reference namelist', lwp ) 
     73901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_apr in reference namelist' ) 
    7474 
    7575      REWIND( numnam_cfg )              ! Namelist namsbc_apr in configuration namelist : File for atmospheric pressure forcing 
    7676      READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 ) 
    77 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist', lwp ) 
     77902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist' ) 
    7878      IF(lwm) WRITE ( numond, namsbc_apr ) 
    7979      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcblk.F90

    r11334 r11348  
    187187      REWIND( numnam_ref )                !* Namelist namsbc_blk in reference namelist : bulk parameters 
    188188      READ  ( numnam_ref, namsbc_blk, IOSTAT = ios, ERR = 901) 
    189 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_blk in reference namelist', lwp ) 
     189901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_blk in reference namelist' ) 
    190190      ! 
    191191      REWIND( numnam_cfg )                !* Namelist namsbc_blk in configuration namelist : bulk parameters 
    192192      READ  ( numnam_cfg, namsbc_blk, IOSTAT = ios, ERR = 902 ) 
    193 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_blk in configuration namelist', lwp ) 
     193902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_blk in configuration namelist' ) 
    194194      ! 
    195195      IF(lwm) WRITE( numond, namsbc_blk ) 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbccpl.F90

    r11275 r11348  
    266266      REWIND( numnam_ref )              ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling 
    267267      READ  ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901) 
    268 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp ) 
     268901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist' ) 
    269269      ! 
    270270      REWIND( numnam_cfg )              ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling 
    271271      READ  ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 ) 
    272 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp ) 
     272902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist' ) 
    273273      IF(lwm) WRITE ( numond, namsbc_cpl ) 
    274274      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcflx.F90

    r11267 r11348  
    9393         REWIND( numnam_ref )              ! Namelist namsbc_flx in reference namelist : Files for fluxes 
    9494         READ  ( numnam_ref, namsbc_flx, IOSTAT = ios, ERR = 901) 
    95 901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_flx in reference namelist', lwp ) 
     95901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_flx in reference namelist' ) 
    9696 
    9797         REWIND( numnam_cfg )              ! Namelist namsbc_flx in configuration namelist : Files for fluxes 
    9898         READ  ( numnam_cfg, namsbc_flx, IOSTAT = ios, ERR = 902 ) 
    99 902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist', lwp ) 
     99902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist' ) 
    100100         IF(lwm) WRITE ( numond, namsbc_flx )  
    101101         ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcice_cice.F90

    r10425 r11348  
    764764         REWIND( numnam_ref )              ! Namelist namsbc_cice in reference namelist :  
    765765         READ  ( numnam_ref, namsbc_cice, IOSTAT = ios, ERR = 901) 
    766 901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cice in reference namelist', lwp ) 
     766901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cice in reference namelist' ) 
    767767 
    768768         REWIND( numnam_cfg )              ! Namelist namsbc_cice in configuration namelist : Parameters of the run 
    769769         READ  ( numnam_cfg, namsbc_cice, IOSTAT = ios, ERR = 902 ) 
    770 902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_cice in configuration namelist', lwp ) 
     770902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_cice in configuration namelist' ) 
    771771         IF(lwm) WRITE ( numond, namsbc_cice ) 
    772772 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcice_if.F90

    r10068 r11348  
    7676         REWIND( numnam_ref )              ! Namelist namsbc_iif in reference namelist : Ice if file 
    7777         READ  ( numnam_ref, namsbc_iif, IOSTAT = ios, ERR = 901) 
    78 901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_iif in reference namelist', lwp ) 
     78901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_iif in reference namelist' ) 
    7979 
    8080         REWIND( numnam_cfg )              ! Namelist Namelist namsbc_iif in configuration namelist : Ice if file 
    8181         READ  ( numnam_cfg, namsbc_iif, IOSTAT = ios, ERR = 902 ) 
    82 902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_iif in configuration namelist', lwp ) 
     82902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_iif in configuration namelist' ) 
    8383         IF(lwm) WRITE ( numond, namsbc_iif ) 
    8484 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcisf.F90

    r10536 r11348  
    278278      REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs  
    279279      READ  ( numnam_ref, namsbc_isf, IOSTAT = ios, ERR = 901) 
    280 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_isf in reference namelist', lwp ) 
     280901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_isf in reference namelist' ) 
    281281 
    282282      REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs 
    283283      READ  ( numnam_cfg, namsbc_isf, IOSTAT = ios, ERR = 902 ) 
    284 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist', lwp ) 
     284902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist' ) 
    285285      IF(lwm) WRITE ( numond, namsbc_isf ) 
    286286 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcmod.F90

    r11275 r11348  
    112112      REWIND( numnam_ref )          !* Namelist namsbc in reference namelist : Surface boundary 
    113113      READ  ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901) 
    114 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp ) 
     114901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist' ) 
    115115      REWIND( numnam_cfg )          !* Namelist namsbc in configuration namelist : Parameters of the run 
    116116      READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 
    117 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp ) 
     117902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist' ) 
    118118      IF(lwm) WRITE( numond, namsbc ) 
    119119      ! 
     
    263263      IF( ln_dm2dc ) THEN           !* daily mean to diurnal cycle 
    264264         nday_qsr = -1   ! allow initialization at the 1st call 
    265          IF( .NOT.( ln_flx .OR. ln_blk ) .AND. nn_components /= jp_iam_opa )   & 
    266             &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires a flux or bulk formulation' ) 
     265         IF( .NOT.( ln_flx .OR. ln_blk .OR. ln_abl ) .AND. nn_components /= jp_iam_opa )   & 
     266            &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires flux, bulk or abl formulation' ) 
    267267      ENDIF 
    268268      !                             !* Choice of the Surface Boudary Condition 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcrnf.F90

    r10523 r11348  
    267267      REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs  
    268268      READ  ( numnam_ref, namsbc_rnf, IOSTAT = ios, ERR = 901) 
    269 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_rnf in reference namelist', lwp ) 
     269901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_rnf in reference namelist' ) 
    270270 
    271271      REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs 
    272272      READ  ( numnam_cfg, namsbc_rnf, IOSTAT = ios, ERR = 902 ) 
    273 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_rnf in configuration namelist', lwp ) 
     273902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_rnf in configuration namelist' ) 
    274274      IF(lwm) WRITE ( numond, namsbc_rnf ) 
    275275      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcssr.F90

    r10068 r11348  
    166166      REWIND( numnam_ref )              ! Namelist namsbc_ssr in reference namelist :  
    167167      READ  ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901) 
    168 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_ssr in reference namelist', lwp ) 
     168901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_ssr in reference namelist' ) 
    169169 
    170170      REWIND( numnam_cfg )              ! Namelist namsbc_ssr in configuration namelist : 
    171171      READ  ( numnam_cfg, namsbc_ssr, IOSTAT = ios, ERR = 902 ) 
    172 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist', lwp ) 
     172902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist' ) 
    173173      IF(lwm) WRITE ( numond, namsbc_ssr ) 
    174174 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcwave.F90

    r10425 r11348  
    397397      REWIND( numnam_ref )              ! Namelist namsbc_wave in reference namelist : File for drag coeff. from wave model 
    398398      READ  ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901) 
    399 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_wave in reference namelist', lwp ) 
     399901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_wave in reference namelist' ) 
    400400          
    401401      REWIND( numnam_cfg )              ! Namelist namsbc_wave in configuration namelist : File for drag coeff. from wave model 
    402402      READ  ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 ) 
    403 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist', lwp ) 
     403902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist' ) 
    404404      IF(lwm) WRITE ( numond, namsbc_wave ) 
    405405      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/tideini.F90

    r10068 r11348  
    6060      REWIND( numnam_ref )              ! Namelist nam_tide in reference namelist : Tides 
    6161      READ  ( numnam_ref, nam_tide, IOSTAT = ios, ERR = 901) 
    62 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_tide in reference namelist', lwp ) 
     62901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_tide in reference namelist' ) 
    6363      ! 
    6464      REWIND( numnam_cfg )              ! Namelist nam_tide in configuration namelist : Tides 
    6565      READ  ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 ) 
    66 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_tide in configuration namelist', lwp ) 
     66902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_tide in configuration namelist' ) 
    6767      IF(lwm) WRITE ( numond, nam_tide ) 
    6868      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/STO/stopar.F90

    r10425 r11348  
    263263      REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme 
    264264      READ  ( numnam_ref, namsto, IOSTAT = ios, ERR = 901) 
    265 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsto in reference namelist', lwp ) 
     265901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsto in reference namelist' ) 
    266266 
    267267      REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme 
    268268      READ  ( numnam_cfg, namsto, IOSTAT = ios, ERR = 902 ) 
    269 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namsto in configuration namelist', lwp ) 
     269902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namsto in configuration namelist' ) 
    270270      IF(lwm) WRITE ( numond, namsto ) 
    271271 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/TRA/eosbn2.F90

    r10425 r11348  
    3030   !!   eos_insitu_2d : Compute the in situ density for 2d fields 
    3131   !!   bn2           : Compute the Brunt-Vaisala frequency 
     32   !!   bn2           : compute the Brunt-Vaisala frequency 
     33   !!   eos_pt_from_ct: compute the potential temperature from the Conservative Temperature 
    3234   !!   eos_rab       : generic interface of in situ thermal/haline expansion ratio  
    3335   !!   eos_rab_3d    : compute in situ thermal/haline expansion ratio 
     
    7476 
    7577   !                               !!** Namelist nameos ** 
    76    LOGICAL , PUBLIC ::   ln_TEOS10   ! determine if eos_pt_from_ct is used to compute sst_m 
    77    LOGICAL , PUBLIC ::   ln_EOS80   ! determine if eos_pt_from_ct is used to compute sst_m 
    78    LOGICAL , PUBLIC ::   ln_SEOS   ! determine if eos_pt_from_ct is used to compute sst_m 
     78   LOGICAL , PUBLIC ::   ln_TEOS10 
     79   LOGICAL , PUBLIC ::   ln_EOS80 
     80   LOGICAL , PUBLIC ::   ln_SEOS 
    7981 
    8082   ! Parameters 
     
    12351237      REWIND( numnam_ref )              ! Namelist nameos in reference namelist : equation of state 
    12361238      READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 ) 
    1237 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nameos in reference namelist', lwp ) 
     1239901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nameos in reference namelist' ) 
    12381240      ! 
    12391241      REWIND( numnam_cfg )              ! Namelist nameos in configuration namelist : equation of state 
    12401242      READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 
    1241 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp ) 
     1243902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nameos in configuration namelist' ) 
    12421244      IF(lwm) WRITE( numond, nameos ) 
    12431245      ! 
     
    16471649         ! 
    16481650      CASE( np_seos )                        !==  Simplified EOS     ==! 
     1651 
     1652         r1_S0  = 0.875_wp/35.16504_wp   ! Used to convert CT in potential temperature when using bulk formulae (eos_pt_from_ct) 
     1653          
    16491654         IF(lwp) THEN 
    16501655            WRITE(numout,*) 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/TRA/traadv.F90

    r10068 r11348  
    196196      REWIND( numnam_ref )                   ! Namelist namtra_adv in reference namelist : Tracer advection scheme 
    197197      READ  ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901) 
    198 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_adv in reference namelist', lwp ) 
     198901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_adv in reference namelist' ) 
    199199      ! 
    200200      REWIND( numnam_cfg )                   ! Namelist namtra_adv in configuration namelist : Tracer advection scheme 
    201201      READ  ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 ) 
    202 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_adv in configuration namelist', lwp ) 
     202902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_adv in configuration namelist' ) 
    203203      IF(lwm) WRITE( numond, namtra_adv ) 
    204204      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/TRA/trabbc.F90

    r10425 r11348  
    135135      REWIND( numnam_ref )              ! Namelist nambbc in reference namelist : Bottom momentum boundary condition 
    136136      READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901) 
    137 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp ) 
     137901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in reference namelist' ) 
    138138      ! 
    139139      REWIND( numnam_cfg )              ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition 
    140140      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 ) 
    141 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp ) 
     141902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbc in configuration namelist' ) 
    142142      IF(lwm) WRITE ( numond, nambbc ) 
    143143      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/TRA/trabbl.F90

    r10425 r11348  
    485485      REWIND( numnam_ref )              ! Namelist nambbl in reference namelist : Bottom boundary layer scheme 
    486486      READ  ( numnam_ref, nambbl, IOSTAT = ios, ERR = 901) 
    487 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in reference namelist', lwp ) 
     487901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in reference namelist' ) 
    488488      ! 
    489489      REWIND( numnam_cfg )              ! Namelist nambbl in configuration namelist : Bottom boundary layer scheme 
    490490      READ  ( numnam_cfg, nambbl, IOSTAT = ios, ERR = 902 ) 
    491 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp ) 
     491902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbl in configuration namelist' ) 
    492492      IF(lwm) WRITE ( numond, nambbl ) 
    493493      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/TRA/tradmp.F90

    r10425 r11348  
    179179      REWIND( numnam_ref )   ! Namelist namtra_dmp in reference namelist : T & S relaxation 
    180180      READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901) 
    181 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp ) 
     181901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_dmp in reference namelist' ) 
    182182      ! 
    183183      REWIND( numnam_cfg )   ! Namelist namtra_dmp in configuration namelist : T & S relaxation 
    184184      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 ) 
    185 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp ) 
     185902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist' ) 
    186186      IF(lwm) WRITE ( numond, namtra_dmp ) 
    187187      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/TRA/tramle.F90

    r10425 r11348  
    268268      REWIND( numnam_ref )              ! Namelist namtra_mle in reference namelist : Tracer advection scheme 
    269269      READ  ( numnam_ref, namtra_mle, IOSTAT = ios, ERR = 901) 
    270 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_mle in reference namelist', lwp ) 
     270901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_mle in reference namelist' ) 
    271271 
    272272      REWIND( numnam_cfg )              ! Namelist namtra_mle in configuration namelist : Tracer advection scheme 
    273273      READ  ( numnam_cfg, namtra_mle, IOSTAT = ios, ERR = 902 ) 
    274 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_mle in configuration namelist', lwp ) 
     274902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_mle in configuration namelist' ) 
    275275      IF(lwm) WRITE ( numond, namtra_mle ) 
    276276 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/TRA/traqsr.F90

    r10425 r11348  
    338338      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference     namelist 
    339339      READ  ( numnam_ref, namtra_qsr, IOSTAT = ios, ERR = 901) 
    340 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in reference namelist', lwp ) 
     340901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in reference namelist' ) 
    341341      ! 
    342342      REWIND( numnam_cfg )              ! Namelist namtra_qsr in configuration namelist 
    343343      READ  ( numnam_cfg, namtra_qsr, IOSTAT = ios, ERR = 902 ) 
    344 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp ) 
     344902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist' ) 
    345345      IF(lwm) WRITE ( numond, namtra_qsr ) 
    346346      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/TRD/trdini.F90

    r10068 r11348  
    4848      REWIND( numnam_ref )              ! Namelist namtrd in reference namelist : trends diagnostic 
    4949      READ  ( numnam_ref, namtrd, IOSTAT = ios, ERR = 901 ) 
    50 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrd in reference namelist', lwp ) 
     50901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrd in reference namelist' ) 
    5151      ! 
    5252      REWIND( numnam_cfg )              ! Namelist namtrd in configuration namelist : trends diagnostic 
    5353      READ  ( numnam_cfg, namtrd, IOSTAT = ios, ERR = 902 ) 
    54 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrd in configuration namelist', lwp ) 
     54902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrd in configuration namelist' ) 
    5555      IF(lwm) WRITE( numond, namtrd ) 
    5656      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/TRD/trdmxl.F90

    r10425 r11348  
    734734      REWIND( numnam_ref )              ! Namelist namtrd_mxl in reference namelist : mixed layer trends diagnostic 
    735735      READ  ( numnam_ref, namtrd_mxl, IOSTAT = ios, ERR = 901 ) 
    736 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrd_mxl in reference namelist', lwp ) 
     736901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrd_mxl in reference namelist' ) 
    737737 
    738738      REWIND( numnam_cfg )              ! Namelist namtrd_mxl in configuration namelist : mixed layer trends diagnostic 
    739739      READ  ( numnam_cfg, namtrd_mxl, IOSTAT = ios, ERR = 902 ) 
    740 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrd_mxl in configuration namelist', lwp ) 
     740902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrd_mxl in configuration namelist' ) 
    741741      IF(lwm) WRITE( numond, namtrd_mxl ) 
    742742      ! 
     
    764764 
    765765      IF( MOD( nitend, nn_trd ) /= 0 ) THEN 
    766          WRITE(numout,cform_err) 
    767          WRITE(numout,*) '                Your nitend parameter, nitend = ', nitend 
    768          WRITE(numout,*) '                is no multiple of the trends diagnostics frequency        ' 
    769          WRITE(numout,*) '                          you defined, nn_trd   = ', nn_trd 
    770          WRITE(numout,*) '                This will not allow you to restart from this simulation.  ' 
    771          WRITE(numout,*) '                You should reconsider this choice.                        '  
    772          WRITE(numout,*)  
    773          WRITE(numout,*) '                N.B. the nitend parameter is also constrained to be a     ' 
    774          WRITE(numout,*) '                     multiple of the nn_fsbc parameter ' 
    775          CALL ctl_stop( 'trd_mxl_init: see comment just above' ) 
     766         WRITE(ctmp1,*) '                Your nitend parameter, nitend = ', nitend 
     767         WRITE(ctmp2,*) '                is no multiple of the trends diagnostics frequency        ' 
     768         WRITE(ctmp3,*) '                          you defined, nn_trd   = ', nn_trd 
     769         WRITE(ctmp4,*) '                This will not allow you to restart from this simulation.  ' 
     770         WRITE(ctmp5,*) '                You should reconsider this choice.                        '  
     771         WRITE(ctmp6,*)  
     772         WRITE(ctmp7,*) '                N.B. the nitend parameter is also constrained to be a     ' 
     773         WRITE(ctmp8,*) '                     multiple of the nn_fsbc parameter ' 
     774         CALL ctl_stop( ctmp1, ctmp2, ctmp3, ctmp4, ctmp5, ctmp6, ctmp7, ctmp8 ) 
    776775      END IF 
    777776 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/USR/usrdef_nam.F90

    r10069 r11348  
    3737CONTAINS 
    3838 
    39    SUBROUTINE usr_def_nam( ldtxt, ldnam, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio ) 
     39   SUBROUTINE usr_def_nam( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio ) 
    4040      !!---------------------------------------------------------------------- 
    4141      !!                     ***  ROUTINE dom_nam  *** 
     
    4949      !! ** input   : - namusr_def namelist found in namelist_cfg 
    5050      !!---------------------------------------------------------------------- 
    51       CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt, ldnam    ! stored print information 
    52       CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name 
    53       INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution 
    54       INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes  
    55       INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.  
     51      CHARACTER(len=*), INTENT(out) ::   cd_cfg          ! configuration name 
     52      INTEGER         , INTENT(out) ::   kk_cfg          ! configuration resolution 
     53      INTEGER         , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes  
     54      INTEGER         , INTENT(out) ::   kperio          ! lateral global domain b.c.  
    5655      ! 
    57       INTEGER ::   ios, ii   ! Local integer 
     56      INTEGER ::   ios   ! Local integer 
    5857      !! 
    5958      NAMELIST/namusr_def/ nn_GYRE, ln_bench, jpkglo 
    6059      !!---------------------------------------------------------------------- 
    6160      ! 
    62       ii = 1 
    63       ! 
    6461      REWIND( numnam_cfg )          ! Namelist namusr_def (exist in namelist_cfg only) 
    6562      READ  ( numnam_cfg, namusr_def, IOSTAT = ios, ERR = 902 ) 
    66 902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namusr_def in configuration namelist', .TRUE. ) 
     63902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namusr_def in configuration namelist' ) 
    6764      ! 
    68       WRITE( ldnam(:), namusr_def ) 
     65      WRITE( numond, namusr_def ) 
    6966      ! 
    7067      cd_cfg = 'GYRE'               ! name & resolution (not used) 
     
    8380#endif 
    8481      kpk = jpkglo 
    85       ! 
    86       !                             ! control print 
    87       WRITE(ldtxt(ii),*) '   '                                                                            ;   ii = ii + 1 
    88       WRITE(ldtxt(ii),*) 'usr_def_nam  : read the user defined namelist (namusr_def) in namelist_cfg'     ;   ii = ii + 1 
    89       WRITE(ldtxt(ii),*) '~~~~~~~~~~~ '                                                                   ;   ii = ii + 1 
    90       WRITE(ldtxt(ii),*) '   Namelist namusr_def : GYRE case'                                             ;   ii = ii + 1 
    91       WRITE(ldtxt(ii),*) '      GYRE used as Benchmark (=T)                      ln_bench  = ', ln_bench  ;   ii = ii + 1 
    92       WRITE(ldtxt(ii),*) '      inverse resolution & implied domain size         nn_GYRE   = ', nn_GYRE   ;   ii = ii + 1 
    93 #if defined key_agrif 
    94       IF( Agrif_Root() ) THEN 
    95 #endif 
    96       WRITE(ldtxt(ii),*) '         jpiglo = 30*nn_GYRE+2                            jpiglo = ', kpi       ;   ii = ii + 1 
    97       WRITE(ldtxt(ii),*) '         jpjglo = 20*nn_GYRE+2                            jpjglo = ', kpj       ;   ii = ii + 1 
    98 #if defined key_agrif 
    99       ENDIF 
    100 #endif 
    101       WRITE(ldtxt(ii),*) '      number of model levels                              jpkglo = ', kpk       ;   ii = ii + 1 
    102       ! 
    10382      !                             ! Set the lateral boundary condition of the global domain 
    10483      kperio = 0                    ! GYRE configuration : closed domain 
    10584      ! 
    106       WRITE(ldtxt(ii),*) '   '                                                                            ;   ii = ii + 1 
    107       WRITE(ldtxt(ii),*) '   Lateral b.c. of the global domain set to closed     jperio = ', kperio       ;   ii = ii + 1 
     85      !                             ! control print 
     86      IF(lwp) THEN 
     87         WRITE(numout,*) '   ' 
     88         WRITE(numout,*) 'usr_def_nam  : read the user defined namelist (namusr_def) in namelist_cfg' 
     89         WRITE(numout,*) '~~~~~~~~~~~ ' 
     90         WRITE(numout,*) '   Namelist namusr_def : GYRE case' 
     91         WRITE(numout,*) '      GYRE used as Benchmark (=T)                      ln_bench  = ', ln_bench 
     92         WRITE(numout,*) '      inverse resolution & implied domain size         nn_GYRE   = ', nn_GYRE 
     93#if defined key_agrif 
     94         IF( Agrif_Root() ) THEN 
     95#endif 
     96         WRITE(numout,*) '         jpiglo = 30*nn_GYRE+2                            jpiglo = ', kpi 
     97         WRITE(numout,*) '         jpjglo = 20*nn_GYRE+2                            jpjglo = ', kpj 
     98#if defined key_agrif 
     99         ENDIF 
     100#endif 
     101         WRITE(numout,*) '      number of model levels                              jpkglo = ', kpk 
     102         WRITE(numout,*) '   ' 
     103         WRITE(numout,*) '   Lateral b.c. of the global domain set to closed        jperio = ', kperio 
     104      ENDIF 
    108105      ! 
    109106   END SUBROUTINE usr_def_nam 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/ZDF/zdfdrg.F90

    r10069 r11348  
    238238      REWIND( numnam_ref )                   ! Namelist namdrg in reference namelist 
    239239      READ  ( numnam_ref, namdrg, IOSTAT = ios, ERR = 901) 
    240 901   IF( ios /= 0 )   CALL ctl_nam( ios , 'namdrg in reference namelist', lwp ) 
     240901   IF( ios /= 0 )   CALL ctl_nam( ios , 'namdrg in reference namelist' ) 
    241241      REWIND( numnam_cfg )                   ! Namelist namdrg in configuration namelist 
    242242      READ  ( numnam_cfg, namdrg, IOSTAT = ios, ERR = 902 ) 
    243 902   IF( ios >  0 )   CALL ctl_nam( ios , 'namdrg in configuration namelist', lwp ) 
     243902   IF( ios >  0 )   CALL ctl_nam( ios , 'namdrg in configuration namelist' ) 
    244244      IF(lwm) WRITE ( numond, namdrg ) 
    245245      ! 
     
    338338      IF(ll_top)   READ  ( numnam_ref, namdrg_top, IOSTAT = ios, ERR = 901) 
    339339      IF(ll_bot)   READ  ( numnam_ref, namdrg_bot, IOSTAT = ios, ERR = 901) 
    340 901   IF( ios /= 0 )   CALL ctl_nam( ios , TRIM(cl_namref), lwp ) 
     340901   IF( ios /= 0 )   CALL ctl_nam( ios , TRIM(cl_namref) ) 
    341341      REWIND( numnam_cfg )                   ! Namelist cd_namdrg in configuration namelist 
    342342      IF(ll_top)   READ  ( numnam_cfg, namdrg_top, IOSTAT = ios, ERR = 902 ) 
    343343      IF(ll_bot)   READ  ( numnam_cfg, namdrg_bot, IOSTAT = ios, ERR = 902 ) 
    344 902   IF( ios >  0 )   CALL ctl_nam( ios , TRIM(cl_namcfg), lwp ) 
     344902   IF( ios >  0 )   CALL ctl_nam( ios , TRIM(cl_namcfg) ) 
    345345      IF(lwm .AND. ll_top)   WRITE ( numond, namdrg_top ) 
    346346      IF(lwm .AND. ll_bot)   WRITE ( numond, namdrg_bot ) 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/ZDF/zdfgls.F90

    r10425 r11348  
    859859      REWIND( numnam_ref )              ! Namelist namzdf_gls in reference namelist : Vertical eddy diffivity and viscosity using gls turbulent closure scheme 
    860860      READ  ( numnam_ref, namzdf_gls, IOSTAT = ios, ERR = 901) 
    861 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namzdf_gls in reference namelist', lwp ) 
     861901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namzdf_gls in reference namelist' ) 
    862862 
    863863      REWIND( numnam_cfg )              ! Namelist namzdf_gls in configuration namelist : Vertical eddy diffivity and viscosity using gls turbulent closure scheme 
    864864      READ  ( numnam_cfg, namzdf_gls, IOSTAT = ios, ERR = 902 ) 
    865 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namzdf_gls in configuration namelist', lwp ) 
     865902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namzdf_gls in configuration namelist' ) 
    866866      IF(lwm) WRITE ( numond, namzdf_gls ) 
    867867 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/ZDF/zdfiwm.F90

    r10425 r11348  
    424424      REWIND( numnam_ref )              ! Namelist namzdf_iwm in reference namelist : Wave-driven mixing 
    425425      READ  ( numnam_ref, namzdf_iwm, IOSTAT = ios, ERR = 901) 
    426 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namzdf_iwm in reference namelist', lwp ) 
     426901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namzdf_iwm in reference namelist' ) 
    427427      ! 
    428428      REWIND( numnam_cfg )              ! Namelist namzdf_iwm in configuration namelist : Wave-driven mixing 
    429429      READ  ( numnam_cfg, namzdf_iwm, IOSTAT = ios, ERR = 902 ) 
    430 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namzdf_iwm in configuration namelist', lwp ) 
     430902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namzdf_iwm in configuration namelist' ) 
    431431      IF(lwm) WRITE ( numond, namzdf_iwm ) 
    432432      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/ZDF/zdfosm.F90

    r10425 r11348  
    13861386     REWIND( numnam_ref )              ! Namelist namzdf_osm in reference namelist : Osmosis ML model 
    13871387     READ  ( numnam_ref, namzdf_osm, IOSTAT = ios, ERR = 901) 
    1388 901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist', lwp ) 
     1388901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist' ) 
    13891389 
    13901390     REWIND( numnam_cfg )              ! Namelist namzdf_tke in configuration namelist : Turbulent Kinetic Energy 
    13911391     READ  ( numnam_cfg, namzdf_osm, IOSTAT = ios, ERR = 902 ) 
    1392 902  IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_osm in configuration namelist', lwp ) 
     1392902  IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_osm in configuration namelist' ) 
    13931393     IF(lwm) WRITE ( numond, namzdf_osm ) 
    13941394 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/ZDF/zdfphy.F90

    r10907 r11348  
    9393      REWIND( numnam_ref )              ! Namelist namzdf in reference namelist : Vertical mixing parameters 
    9494      READ  ( numnam_ref, namzdf, IOSTAT = ios, ERR = 901) 
    95 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namzdf in reference namelist', lwp ) 
     95901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namzdf in reference namelist' ) 
    9696      ! 
    9797      REWIND( numnam_cfg )              ! Namelist namzdf in reference namelist : Vertical mixing parameters 
    9898      READ  ( numnam_cfg, namzdf, IOSTAT = ios, ERR = 902 ) 
    99 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namzdf in configuration namelist', lwp ) 
     99902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namzdf in configuration namelist' ) 
    100100      IF(lwm)   WRITE ( numond, namzdf ) 
    101101      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/ZDF/zdfric.F90

    r10068 r11348  
    8080      REWIND( numnam_ref )              ! Namelist namzdf_ric in reference namelist : Vertical diffusion Kz depends on Richardson number 
    8181      READ  ( numnam_ref, namzdf_ric, IOSTAT = ios, ERR = 901) 
    82 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ric in reference namelist', lwp ) 
     82901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ric in reference namelist' ) 
    8383 
    8484      REWIND( numnam_cfg )              ! Namelist namzdf_ric in configuration namelist : Vertical diffusion Kz depends on Richardson number 
    8585      READ  ( numnam_cfg, namzdf_ric, IOSTAT = ios, ERR = 902 ) 
    86 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_ric in configuration namelist', lwp ) 
     86902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_ric in configuration namelist' ) 
    8787      IF(lwm) WRITE ( numond, namzdf_ric ) 
    8888      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/ZDF/zdftke.F90

    r10425 r11348  
    658658      REWIND( numnam_ref )              ! Namelist namzdf_tke in reference namelist : Turbulent Kinetic Energy 
    659659      READ  ( numnam_ref, namzdf_tke, IOSTAT = ios, ERR = 901) 
    660 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tke in reference namelist', lwp ) 
     660901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tke in reference namelist' ) 
    661661 
    662662      REWIND( numnam_cfg )              ! Namelist namzdf_tke in configuration namelist : Turbulent Kinetic Energy 
    663663      READ  ( numnam_cfg, namzdf_tke, IOSTAT = ios, ERR = 902 ) 
    664 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_tke in configuration namelist', lwp ) 
     664902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_tke in configuration namelist' ) 
    665665      IF(lwm) WRITE ( numond, namzdf_tke ) 
    666666      ! 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/module_example

    r10425 r11348  
    152152      REWIND( numnam_ref )              ! Namelist namexa in reference namelist : Example 
    153153      READ  ( numnam_ref, namexa, IOSTAT = ios, ERR = 901) 
    154 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in reference namelist', lwp ) 
     154901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in reference namelist' ) 
    155155      ! 
    156156      REWIND( numnam_cfg )              ! Namelist namexa in configuration namelist : Example 
    157157      READ  ( numnam_cfg, namexa, IOSTAT = ios, ERR = 902 ) 
    158 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namexa in configuration namelist', lwp ) 
     158902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namexa in configuration namelist' ) 
    159159   ! Output namelist for control 
    160160      WRITE ( numond, namexa ) 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/nemogcm.F90

    r10588 r11348  
    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      !!---------------------------------------------------------------------- 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OFF/dtadyn.F90

    r10425 r11348  
    227227      REWIND( numnam_ref )              ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data 
    228228      READ  ( numnam_ref, namdta_dyn, IOSTAT = ios, ERR = 901) 
    229 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdta_dyn in reference namelist', lwp ) 
     229901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdta_dyn in reference namelist' ) 
    230230      REWIND( numnam_cfg )              ! Namelist namdta_dyn in configuration namelist : Offline: init. of dynamical data 
    231231      READ  ( numnam_cfg, namdta_dyn, IOSTAT = ios, ERR = 902 ) 
    232 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist', lwp ) 
     232902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist' ) 
    233233      IF(lwm) WRITE ( numond, namdta_dyn ) 
    234234      !                                         ! store namelist information in an array 
     
    477477      REWIND( numnam_ref )              ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data 
    478478      READ  ( numnam_ref, namdta_dyn, IOSTAT = ios, ERR = 901) 
    479 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdta_dyn in reference namelist', lwp ) 
     479901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdta_dyn in reference namelist' ) 
    480480      REWIND( numnam_cfg )              ! Namelist namdta_dyn in configuration namelist : Offline: init. of dynamical data 
    481481      READ  ( numnam_cfg, namdta_dyn, IOSTAT = ios, ERR = 902 ) 
    482 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist', lwp ) 
     482902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist' ) 
    483483      IF(lwm) WRITE ( numond, namdta_dyn ) 
    484484      !                                         ! store namelist information in an array 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OFF/nemogcm.F90

    r10601 r11348  
    131131 
    132132      IF( nstop /= 0 .AND. lwp ) THEN                 ! error print 
    133          WRITE(numout,cform_err) 
    134          WRITE(numout,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    135          WRITE(numout,*) 
     133         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
     134         CALL ctl_stop( ctmp1 ) 
    136135      ENDIF 
    137136      ! 
     
    146145#endif 
    147146      ! 
     147      IF(lwm) THEN 
     148         IF( nstop == 0 ) THEN   ;   STOP 0 
     149         ELSE                    ;   STOP 123 
     150         ENDIF 
     151      ENDIF 
     152      ! 
    148153   END SUBROUTINE nemo_gcm 
    149154 
     
    155160      !! ** Purpose :   initialization of the nemo model in off-line mode 
    156161      !!---------------------------------------------------------------------- 
    157       INTEGER  ::   ji                 ! dummy loop indices 
    158       INTEGER  ::   ios, ilocal_comm   ! local integers 
    159       CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam 
     162      INTEGER ::   ios, ilocal_comm   ! local integers 
    160163      !! 
    161164      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   & 
     
    165168      !!---------------------------------------------------------------------- 
    166169      ! 
    167       cltxt  = '' 
    168       cltxt2 = '' 
    169       clnam  = ''   
    170170      cxios_context = 'nemo' 
    171171      ! 
    172       !                             ! Open reference namelist and configuration namelist files 
    173       CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    174       CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     172      !                             !-------------------------------------------------! 
     173      !                             !     set communicator & select the local rank    ! 
     174      !                             !  must be done as soon as possible to get narea  ! 
     175      !                             !-------------------------------------------------! 
     176      ! 
     177#if defined key_iomput 
     178      CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios 
     179      CALL mpp_start( ilocal_comm ) 
     180#else 
     181      CALL mpp_start( ) 
     182#endif 
     183      ! 
     184      narea = mpprank + 1               ! mpprank: the rank of proc (0 --> mppsize -1 ) 
     185      lwm = (narea == 1)                ! control of output namelists 
     186      ! 
     187      !                             !---------------------------------------------------------------! 
     188      !                             ! Open output files, reference and configuration namelist files ! 
     189      !                             !---------------------------------------------------------------! 
     190      ! 
     191      ! open ocean.output as soon as possible to get all output prints (including errors messages) 
     192      IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     193      ! open reference and configuration namelist files 
     194                  CALL ctl_opn( numnam_ref,        'namelist_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     195                  CALL ctl_opn( numnam_cfg,        'namelist_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     196      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     197      ! open /dev/null file to be able to supress output write easily 
     198                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     199      ! 
     200      !                             !--------------------! 
     201      !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp 
     202      !                             !--------------------! 
    175203      ! 
    176204      REWIND( numnam_ref )              ! Namelist namctl in reference namelist 
    177205      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    178 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
     206901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' ) 
    179207      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    180208      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    181 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    182       ! 
    183       REWIND( numnam_ref )              ! Namelist namcfg in reference namelist 
    184       READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    185 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    186       REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist 
    187       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    188 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    189  
    190       !                             !--------------------------! 
    191       !                             !  Set global domain size  !   (control print return in cltxt2) 
    192       !                             !--------------------------! 
    193       IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
    194          CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     209902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' ) 
     210      ! 
     211      lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print 
     212      ! 
     213      IF(lwp) THEN                            ! open listing units 
    195214         ! 
    196       ELSE                                ! user-defined namelist 
    197          CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
    198       ENDIF 
    199       ! 
    200       l_offline = .true.                  ! passive tracers are run offline 
    201       ! 
    202       !                             !--------------------------------------------! 
    203       !                             !  set communicator & select the local node  ! 
    204       !                             !  NB: mynode also opens output.namelist.dyn ! 
    205       !                             !      on unit number numond on first proc   ! 
    206       !                             !--------------------------------------------! 
    207 #if defined key_iomput 
    208       CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) 
    209       narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
    210 #else 
    211       ilocal_comm = 0 
    212       narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
    213 #endif 
    214  
    215       narea = narea + 1                       ! mynode return the rank of proc (0 --> jpnij -1 ) 
    216  
     215         IF( .NOT. lwm )   &           ! alreay opened for narea == 1 
     216            &     CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 
     217         ! 
     218         WRITE(numout,*) 
     219         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC' 
     220         WRITE(numout,*) '                       NEMO team' 
     221         WRITE(numout,*) '                   Off-line TOP Model' 
     222         WRITE(numout,*) '                NEMO version 4.0  (2019) ' 
     223         WRITE(numout,*) 
     224         WRITE(numout,*) "           ._      ._      ._      ._      ._    " 
     225         WRITE(numout,*) "       _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ " 
     226         WRITE(numout,*) 
     227         WRITE(numout,*) "           o         _,           _,             " 
     228         WRITE(numout,*) "            o      .' (        .-' /             " 
     229         WRITE(numout,*) "           o     _/..._'.    .'   /              " 
     230         WRITE(numout,*) "      (    o .-'`      ` '-./  _.'               " 
     231         WRITE(numout,*) "       )    ( o)           ;= <_         (       " 
     232         WRITE(numout,*) "      (      '-.,\\__ __.-;`\   '.        )      " 
     233         WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   " 
     234         WRITE(numout,*) "      (  (           \_/       '-._\      )   )  " 
     235         WRITE(numout,*) "       )  )                        `     (   (   " 
     236         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
     237         WRITE(numout,*) 
     238         ! 
     239         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
     240         ! 
     241      ENDIF 
     242      ! 
     243      ! finalize the definition of namctl variables 
    217244      IF( sn_cfctl%l_config ) THEN 
    218245         ! Activate finer control of report outputs 
     
    226253         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 
    227254      ENDIF 
    228  
    229       lwm = (narea == 1)                      ! control of output namelists 
    230       lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print 
    231  
    232       IF(lwm) THEN               ! write merged namelists from earlier to output namelist  
    233          !                       ! now that the file has been opened in call to mynode.  
    234          !                       ! NB: nammpp has already been written in mynode (if lk_mpp_mpi) 
    235          WRITE( numond, namctl ) 
    236          WRITE( numond, namcfg ) 
    237          IF( .NOT.ln_read_cfg ) THEN 
    238             DO ji = 1, SIZE(clnam) 
    239                IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print 
    240             END DO 
    241          ENDIF 
    242       ENDIF 
    243  
    244       IF(lwp) THEN                            ! open listing units 
    245          ! 
    246          CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
    247          ! 
    248          WRITE(numout,*) 
    249          WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC' 
    250          WRITE(numout,*) '                       NEMO team' 
    251          WRITE(numout,*) '                   Off-line TOP Model' 
    252          WRITE(numout,*) '                NEMO version 4.0  (2019) ' 
    253          WRITE(numout,*) 
    254          WRITE(numout,*) "           ._      ._      ._      ._      ._    " 
    255          WRITE(numout,*) "       _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ " 
    256          WRITE(numout,*) 
    257          WRITE(numout,*) "           o         _,           _,             " 
    258          WRITE(numout,*) "            o      .' (        .-' /             " 
    259          WRITE(numout,*) "           o     _/..._'.    .'   /              " 
    260          WRITE(numout,*) "      (    o .-'`      ` '-./  _.'               " 
    261          WRITE(numout,*) "       )    ( o)           ;= <_         (       " 
    262          WRITE(numout,*) "      (      '-.,\\__ __.-;`\   '.        )      " 
    263          WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   " 
    264          WRITE(numout,*) "      (  (           \_/       '-._\      )   )  " 
    265          WRITE(numout,*) "       )  )                        `     (   (   " 
    266          WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    267          WRITE(numout,*) 
    268          DO ji = 1, SIZE(cltxt) 
    269             IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) TRIM(cltxt(ji))    ! control print of mynode 
    270          END DO 
    271          WRITE(numout,*) 
    272          WRITE(numout,*) 
    273          DO ji = 1, SIZE(cltxt2) 
    274             IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) TRIM(cltxt2(ji))   ! control print of domain size 
    275          END DO 
    276          ! 
    277          WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
    278          ! 
    279       ENDIF 
    280       ! open /dev/null file to be able to supress output write easily 
    281       CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    282       ! 
    283       !                                      ! Domain decomposition 
    284       CALL mpp_init                          ! MPP 
     255      ! 
     256      IF(lwm) WRITE( numond, namctl ) 
     257      ! 
     258      !                             !------------------------------------! 
     259      !                             !  Set global domain size parameters ! 
     260      !                             !------------------------------------! 
     261      !      
     262      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist 
     263      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
     264903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 
     265      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist 
     266      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
     267904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )    
     268      ! 
     269      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
     270         CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     271      ELSE                                ! user-defined namelist 
     272         CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     273      ENDIF 
     274      ! 
     275      IF(lwm)   WRITE( numond, namcfg ) 
     276      l_offline = .true.                  ! passive tracers are run offline 
     277      ! 
     278      !                             !-----------------------------------------! 
     279      !                             ! mpp parameters and domain decomposition ! 
     280      !                             !-----------------------------------------! 
     281      ! 
     282      CALL mpp_init 
    285283 
    286284      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/SAO/nemogcm.F90

    r10601 r11348  
    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 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/SAO/sao_data.F90

    r10069 r11348  
    5454      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
    5555      READ  ( numnam_ref, namsao, IOSTAT = ios, ERR = 901 ) 
    56 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsao in reference namelist', .TRUE. ) 
     56901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsao in reference namelist' ) 
    5757      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark 
    5858      READ  ( numnam_cfg, namsao, IOSTAT = ios, ERR = 902 ) 
    59 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsao in configuration namelist', .TRUE. ) 
     59902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsao in configuration namelist' ) 
    6060      
    6161      lmask(:) = .FALSE.               ! count input files 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/SAS/nemogcm.F90

    r11263 r11348  
    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