New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 9168 for branches/2017/dev_merge_2017/NEMOGCM/NEMO – NEMO

Ignore:
Timestamp:
2017-12-23T13:27:17+01:00 (6 years ago)
Author:
gm
Message:

dev_merge_2017: OPA_SRC & CONFIG: remove useless warning when reading namelist_cfg

Location:
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC
Files:
55 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r9044 r9168  
    146146      REWIND( numnam_ref )              ! Namelist nam_asminc in reference namelist : Assimilation increment 
    147147      READ  ( numnam_ref, nam_asminc, IOSTAT = ios, ERR = 901) 
    148 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_asminc in reference namelist', lwp ) 
    149  
     148901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_asminc in reference namelist', lwp ) 
    150149      REWIND( numnam_cfg )              ! Namelist nam_asminc in configuration namelist : Assimilation increment 
    151150      READ  ( numnam_cfg, nam_asminc, IOSTAT = ios, ERR = 902 ) 
    152 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_asminc in configuration namelist', lwp ) 
     151902   IF( ios >  0 )  CALL ctl_nam ( ios , 'nam_asminc in configuration namelist', lwp ) 
    153152      IF(lwm) WRITE ( numond, nam_asminc ) 
    154153 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r9124 r9168  
    507507            READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 
    508508901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) 
    509  
    510509            READ  ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 ) 
    511 902         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp ) 
     510902         IF( ios > 0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp ) 
    512511            IF(lwm) WRITE( numond, nambdy_dta ) 
    513512 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r9124 r9168  
    8080      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901) 
    8181901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
    82       ! 
    8382      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries 
    8483      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 ) 
    85 902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
     84902   IF( ios > 0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
    8685      IF(lwm) WRITE ( numond, nambdy ) 
    8786 
     
    419418            icount = icount + 1 
    420419            ! No REWIND here because may need to read more than one nambdy_index namelist. 
    421             ! Read only namelist_cfg to avoid unseccessfull overwrite 
    422 !!          REWIND( numnam_ref )              ! Namelist nambdy_index in reference namelist : Open boundaries indexes 
    423 !!          READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 903) 
    424 !!903       IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_index in reference namelist', lwp ) 
    425  
    426 !!          REWIND( numnam_cfg )              ! Namelist nambdy_index in configuration namelist : Open boundaries indexes 
     420            ! Read only namelist_cfg to avoid unseccessfull overwrite  
     421            ! keep full control of the configuration namelist 
    427422            READ  ( numnam_cfg, nambdy_index, IOSTAT = ios, ERR = 904 ) 
    428423904         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_index in configuration namelist', lwp ) 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r9125 r9168  
    102102            ! Don't REWIND here - may need to read more than one of these namelists.  
    103103            READ  ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901) 
    104 901         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in reference namelist', lwp ) 
     104901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_tide in reference namelist', lwp ) 
    105105            READ  ( numnam_cfg, nambdy_tide, IOSTAT = ios, ERR = 902 ) 
    106 902         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist', lwp ) 
     106902         IF( ios >  0 )  CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist', lwp ) 
    107107            IF(lwm) WRITE ( numond, nambdy_tide ) 
    108108            !                                               ! Parameter control and print 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90

    r6140 r9168  
    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', lwp ) 
    5959      IF(lwm) WRITE ( numond, namc1d ) 
    6060      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90

    r9125 r9168  
    7272      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 
    7373      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 902 ) 
    74 902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
     74902   IF( ios > 0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
    7575 
    7676 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90

    r9125 r9168  
    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', lwp ) 
    6969      IF(lwm) WRITE ( numond, namc1d_uvd ) 
    7070 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90

    r9125 r9168  
    8282      READ  ( numnam_ref, namc1d_dyndmp, IOSTAT = ios, ERR = 901) 
    8383901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist', lwp ) 
    84       ! 
    8584      REWIND( numnam_cfg )              ! Namelist namc1d_dyndmp in configuration namelist : Parameters of the run 
    8685      READ  ( numnam_cfg, namc1d_dyndmp, IOSTAT = ios, ERR = 902 ) 
    87 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', lwp ) 
    8887      IF(lwm) WRITE ( numond, namc1d_dyndmp ) 
    8988      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r9125 r9168  
    7676      !!---------------------------------------------------------------------- 
    7777      ! 
    78       IF(lwp) THEN 
    79          WRITE(numout,*) 
    80          WRITE(numout,*) 'crs_init : Initializing the grid coarsening module ' 
    81       ENDIF 
    82  
    8378     !--------------------------------------------------------- 
    8479     ! 1. Read Namelist file 
    8580     !--------------------------------------------------------- 
    8681     ! 
    87  
    8882      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run 
    8983      READ  ( numnam_ref, namcrs, IOSTAT = ios, ERR = 901) 
    90 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcrs in reference namelist', lwp ) 
    91  
     84901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcrs in reference namelist', lwp ) 
    9285      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run 
    9386      READ  ( numnam_cfg, namcrs, IOSTAT = ios, ERR = 902 ) 
    94 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', lwp ) 
    9588      IF(lwm) WRITE ( numond, namcrs ) 
    9689 
    9790     IF(lwp) THEN 
    9891        WRITE(numout,*) 
    99         WRITE(numout,*) 'crs_init: Namelist namcrs ' 
    100         WRITE(numout,*) '   coarsening factor in i-direction      nn_factx   = ', nn_factx 
    101         WRITE(numout,*) '   coarsening factor in j-direction      nn_facty   = ', nn_facty 
    102         WRITE(numout,*) '   bin centering preference              nn_binref  = ', nn_binref 
    103         WRITE(numout,*) '   create (=1) a mesh file or not (=0)   nn_msh_crs = ', nn_msh_crs 
    104         WRITE(numout,*) '   type of Kz coarsening (0,1,2)         nn_crs_kz  = ', nn_crs_kz 
    105         WRITE(numout,*) '   wn coarsened or computed using hdivn  ln_crs_wn  = ', ln_crs_wn 
     92        WRITE(numout,*) 'crs_init : Initializing the grid coarsening module' 
     93        WRITE(numout,*) '~~~~~~~~' 
     94        WRITE(numout,*) '   Namelist namcrs ' 
     95        WRITE(numout,*) '      coarsening factor in i-direction      nn_factx   = ', nn_factx 
     96        WRITE(numout,*) '      coarsening factor in j-direction      nn_facty   = ', nn_facty 
     97        WRITE(numout,*) '      bin centering preference              nn_binref  = ', nn_binref 
     98        WRITE(numout,*) '      create (=1) a mesh file or not (=0)   nn_msh_crs = ', nn_msh_crs 
     99        WRITE(numout,*) '      type of Kz coarsening (0,1,2)         nn_crs_kz  = ', nn_crs_kz 
     100        WRITE(numout,*) '      wn coarsened or computed using hdivn  ln_crs_wn  = ', ln_crs_wn 
    106101     ENDIF 
    107102               
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90

    r9019 r9168  
    5454      REWIND ( numnam_ref )              ! Read Namelist nam_dia25h in reference namelist : 25hour mean diagnostics 
    5555      READ   ( numnam_ref, nam_dia25h, IOSTAT=ios, ERR= 901 ) 
    56 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_dia25h in reference namelist', lwp ) 
    57  
     56901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_dia25h in reference namelist', lwp ) 
    5857      REWIND( numnam_cfg )              ! Namelist nam_dia25h in configuration namelist  25hour diagnostics 
    5958      READ  ( numnam_cfg, nam_dia25h, IOSTAT = ios, ERR = 902 ) 
    60 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_dia25h in configuration namelist', lwp ) 
     59902   IF( ios >  0 )  CALL ctl_nam ( ios , 'nam_dia25h in configuration namelist', lwp ) 
    6160      IF(lwm) WRITE ( numond, nam_dia25h ) 
    6261 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

    r9124 r9168  
    8888      REWIND( numnam_ref )              ! Namelist nam_diaharm in reference namelist : Tidal harmonic analysis 
    8989      READ  ( numnam_ref, nam_diaharm, IOSTAT = ios, ERR = 901) 
    90 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diaharm in reference namelist', lwp ) 
    91  
     90901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_diaharm in reference namelist', lwp ) 
    9291      REWIND( numnam_cfg )              ! Namelist nam_diaharm in configuration namelist : Tidal harmonic analysis 
    9392      READ  ( numnam_cfg, nam_diaharm, IOSTAT = ios, ERR = 902 ) 
    94 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist', lwp ) 
     93902   IF( ios >  0 )  CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist', lwp ) 
    9594      IF(lwm) WRITE ( numond, nam_diaharm ) 
    9695      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r9124 r9168  
    1313   !!   dia_hsb_init  : Initialization of the conservation diagnostic 
    1414   !!---------------------------------------------------------------------- 
    15    USE oce             ! ocean dynamics and tracers 
    16    USE dom_oce         ! ocean space and time domain 
    17    USE phycst          ! physical constants 
    18    USE sbc_oce         ! surface thermohaline fluxes 
    19    USE sbcrnf          ! river runoff 
    20    USE sbcisf          ! ice shelves 
    21    USE domvvl          ! vertical scale factors 
    22    USE traqsr          ! penetrative solar radiation 
    23    USE trabbc          ! bottom boundary condition  
    24    USE trabbc          ! bottom boundary condition 
    25    USE restart         ! ocean restart 
    26    USE bdy_oce   , ONLY: ln_bdy 
     15   USE oce            ! ocean dynamics and tracers 
     16   USE dom_oce        ! ocean space and time domain 
     17   USE phycst         ! physical constants 
     18   USE sbc_oce        ! surface thermohaline fluxes 
     19   USE sbcrnf         ! river runoff 
     20   USE sbcisf         ! ice shelves 
     21   USE domvvl         ! vertical scale factors 
     22   USE traqsr         ! penetrative solar radiation 
     23   USE trabbc         ! bottom boundary condition  
     24   USE trabbc         ! bottom boundary condition 
     25   USE restart        ! ocean restart 
     26   USE bdy_oce , ONLY : ln_bdy 
    2727   ! 
    28    USE iom             ! I/O manager 
    29    USE in_out_manager  ! I/O manager 
    30    USE lib_fortran     ! glob_sum 
    31    USE lib_mpp         ! distributed memory computing library 
    32    USE timing          ! preformance summary 
     28   USE iom            ! I/O manager 
     29   USE in_out_manager ! I/O manager 
     30   USE lib_fortran    ! glob_sum 
     31   USE lib_mpp        ! distributed memory computing library 
     32   USE timing         ! preformance summary 
    3333 
    3434   IMPLICIT NONE 
     
    346346      REWIND( numnam_ref )              ! Namelist namhsb in reference namelist 
    347347      READ  ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) 
    348 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in reference namelist', lwp ) 
    349  
     348901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namhsb in reference namelist', lwp ) 
    350349      REWIND( numnam_cfg )              ! Namelist namhsb in configuration namelist 
    351350      READ  ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 
    352 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp ) 
     351902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp ) 
    353352      IF(lwm) WRITE ( numond, namhsb ) 
    354353 
    355354      IF(lwp) THEN 
    356355         WRITE(numout,*) 
    357          WRITE(numout,*) 'dia_hsb_init' 
    358          WRITE(numout,*) '~~~~~~~~ ' 
    359          WRITE(numout,*) '  check the heat and salt budgets (T) or not (F)       ln_diahsb = ', ln_diahsb 
     356         WRITE(numout,*) 'dia_hsb_init : heat and salt budgets diagnostics' 
     357         WRITE(numout,*) '~~~~~~~~~~~~ ' 
     358         WRITE(numout,*) '   Namelist  namhsb :' 
     359         WRITE(numout,*) '      check the heat and salt budgets (T) or not (F)       ln_diahsb = ', ln_diahsb 
    360360      ENDIF 
    361361      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIU/diurnal_bulk.F90

    r6010 r9168  
    1919    
    2020   IMPLICIT NONE 
     21   PRIVATE 
    2122    
    2223   ! Namelist parameters 
     
    3435   !                                                           ! absorbed radiation 
    3536 
    36    PRIVATE 
    3737   PUBLIC diurnal_sst_bulk_init, diurnal_sst_takaya_step 
    3838    
    39    CONTAINS  
     39   !!---------------------------------------------------------------------- 
     40CONTAINS  
    4041    
    4142   SUBROUTINE diurnal_sst_bulk_init 
     
    4344      !! *** ROUTINE diurnal_sst_init *** 
    4445      !! 
    45       !! ** Purpose : Initialise the Takaya diurnal model 
    46        
    47       !!---------------------------------------------------------------------- 
    48        
    49       IMPLICIT NONE 
    50        
    51       INTEGER :: ios 
    52        
     46      !! ** Purpose : Initialise the Takaya diurnal model    
     47      !!----------------------------------------------------------------------       
     48      INTEGER ::   ios   ! local integer 
     49      !! 
    5350      NAMELIST /namdiu/ ln_diurnal, ln_diurnal_only 
    54        
     51      !!----------------------------------------------------------------------       
     52 
    5553      ! Read the namelist 
    5654      REWIND( numnam_ref ) 
    57       READ( numnam_ref, namdiu, IOSTAT = ios, ERR = 901 ) 
    58 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdiu in reference namelist', lwp ) 
     55      READ  ( numnam_ref, namdiu, IOSTAT = ios, ERR = 901 ) 
     56901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdiu in reference namelist', lwp ) 
    5957      REWIND( numnam_cfg ) 
    60       READ( numnam_cfg, namdiu, IOSTAT = ios, ERR = 902 ) 
    61 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdiu in configuration namelist', lwp )       
    62        
    63       IF ( ln_diurnal_only .AND. ( .NOT. ln_diurnal ) ) THEN 
     58      READ  ( numnam_cfg, namdiu, IOSTAT = ios, ERR = 902 ) 
     59902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namdiu in configuration namelist', lwp )       
     60      ! 
     61      IF( ln_diurnal_only .AND. ( .NOT. ln_diurnal ) ) THEN 
    6462         CALL ctl_stop( "ln_diurnal_only set, but ln_diurnal = FALSE !" ) 
    6563      ENDIF 
    6664       
    67       IF ( ln_diurnal ) THEN       
    68           
    69          ! Allocate arrays 
     65      IF( ln_diurnal ) THEN       
     66         !          
    7067         ALLOCATE( x_dsst(jpi,jpj), x_solfrac(jpi,jpj) ) 
    71           
    72          ! Initialise the solar fraction 
    73          x_solfrac = 0._wp 
    74          x_dsst = 0._wp 
    75  
    76          IF ( ln_diurnal_only ) THEN 
     68         ! 
     69         x_solfrac = 0._wp         ! Initialise the solar fraction 
     70         x_dsst    = 0._wp 
     71         ! 
     72         IF( ln_diurnal_only ) THEN 
    7773            CALL ctl_warn( "ln_diurnal_only set; only the diurnal component of SST will be calculated" ) 
    7874         ENDIF 
     
    8076       
    8177   END SUBROUTINE diurnal_sst_bulk_init 
    82     
    83    SUBROUTINE diurnal_sst_takaya_step(kt, psolflux, pqflux, ptauflux, prho, p_rdt,& 
     78 
     79 
     80   SUBROUTINE diurnal_sst_takaya_step(kt, psolflux, pqflux, ptauflux, prho, p_rdt,   & 
    8481            &                  pla, pthick, pcoolthick, pmu, & 
    8582            &                  p_fvel_bkginc, p_hflux_bkginc) 
     
    9693      !!                temperature, Takaya et al, JGR, 2010  
    9794      !!---------------------------------------------------------------------- 
    98        
    99       IMPLICIT NONE 
    100        
    101       ! Dummy variables 
    102       REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psolflux  ! solar flux (Watts) 
    103       REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pqflux    ! heat (non-solar)  
    104       !                                                     ! flux (Watts) 
    105       REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: ptauflux  ! wind stress  
    106       !                                                     ! (kg/ m s^2) 
    107       REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: prho      ! water density  
    108       !                                                     ! (kg/m^3) 
    109       REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pLa     
    110       !                                                     ! Langmuir number 
    111       REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pthick  
    112       !                                                     ! warm layer thickness (m) 
    113       REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pcoolthick  
    114       !                                                     ! cool skin thickness (m) 
    115       REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pmu     
    116       !                                                     ! mu parameter 
    117       REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: p_hflux_bkginc   
    118       !                                                     ! optional increment to the 
    119       !                                                     ! heat flux 
    120       REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: p_fvel_bkginc   
    121       !                                                     ! optional increment to the 
    122       !                                                     ! friction velocity 
    123       REAL(wp), INTENT(IN) :: p_rdt                         ! time-step 
    124        
    125       ! Local variables  
     95      INTEGER                               , INTENT(in) ::   kt             ! time step 
     96      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   psolflux       ! solar flux (Watts) 
     97      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   pqflux         ! heat (non-solar) flux (Watts) 
     98      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   ptauflux       ! wind stress  (kg/ m s^2) 
     99      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   prho           ! water density  (kg/m^3) 
     100      REAL(wp)                              , INTENT(in) ::   p_rdt          ! time-step 
     101      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pLa            ! Langmuir number 
     102      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pthick         ! warm layer thickness (m) 
     103      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pcoolthick     ! cool skin thickness (m) 
     104      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pmu            ! mu parameter 
     105      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   p_hflux_bkginc ! increment to the heat flux 
     106      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   p_fvel_bkginc  ! increment to the friction velocity 
     107      ! 
     108      INTEGER :: ji,jj 
     109      LOGICAL  :: ll_calcfrac 
    126110      REAL(wp), DIMENSION(jpi,jpj) :: z_fvel              ! friction velocity      
    127111      REAL(wp), DIMENSION(jpi,jpj) :: zthick, zcoolthick, zmu, zla 
    128112      REAL(wp), DIMENSION(jpi,jpj) :: z_abflux            ! absorbed flux            
    129113      REAL(wp), DIMENSION(jpi,jpj) :: z_fla               ! Langmuir function value  
    130        
    131       LOGICAL  :: ll_calcfrac 
    132        
    133       INTEGER :: ji,jj 
    134       INTEGER, INTENT(IN) :: kt                           ! time step 
     114      !!---------------------------------------------------------------------- 
    135115 
    136116      ! Set optional arguments to their defaults 
    137       IF ( .NOT. PRESENT(pthick) ) THEN  
    138          zthick(:,:) = 3._wp 
    139       ELSE 
    140          zthick(:,:) = pthick(:,:) 
    141       ENDIF 
    142       IF ( .NOT. PRESENT(pcoolthick) ) THEN  
    143          zcoolthick(:,:) = 0._wp 
    144       ELSE 
    145          zcoolthick(:,:) = pcoolthick(:,:) 
    146       ENDIF 
    147       IF ( .NOT. PRESENT(pmu) ) THEN 
    148          zmu(:,:) = 0.3_wp 
    149       ELSE 
    150          zmu(:,:) = pmu(:,:) 
    151       ENDIF 
    152       IF ( .NOT. PRESENT(pla) ) THEN 
    153          zla(:,:) = 0.3_wp 
    154       ELSE 
    155          zla(:,:) = pla(:,:) 
     117      IF( .NOT. PRESENT( pthick )   ) THEN   ;   zthick(:,:) = 3._wp 
     118      ELSE                                   ;   zthick(:,:) = pthick(:,:) 
     119      ENDIF 
     120      IF( .NOT. PRESENT(pcoolthick) ) THEN   ;   zcoolthick(:,:) = 0._wp 
     121      ELSE                                   ;   zcoolthick(:,:) = pcoolthick(:,:) 
     122      ENDIF 
     123      IF( .NOT. PRESENT( pmu )      ) THEN   ;   zmu(:,:) = 0.3_wp 
     124      ELSE                                   ;   zmu(:,:) = pmu(:,:) 
     125      ENDIF 
     126      IF( .NOT. PRESENT(pla) ) THEN          ;   zla(:,:) = 0.3_wp 
     127      ELSE                                   ;   zla(:,:) = pla(:,:) 
    156128      ENDIF 
    157129       
     
    161133            DO ji = 1, jpi 
    162134               IF(  ( x_solfrac(ji,jj) == 0._wp ) .AND. ( tmask(ji,jj,1) == 1._wp ) ) & 
    163                &   x_solfrac(ji,jj) = solfrac( zcoolthick(ji,jj),zthick(ji,jj) ) 
     135                  &   x_solfrac(ji,jj) = solfrac( zcoolthick(ji,jj),zthick(ji,jj) ) 
    164136            END DO 
    165137         END DO    
     
    195167       
    196168      ! Increment the temperature using the implicit solution 
    197       x_dsst(:,:) = t_imp( x_dsst(:,:), p_rdt, z_abflux(:,:), z_fvel(:,:), & 
    198                                  z_fla(:,:), zmu(:,:), zthick(:,:), prho(:,:)) 
    199        
    200                                  
    201        
     169      x_dsst(:,:) = t_imp( x_dsst(:,:), p_rdt, z_abflux(:,:), z_fvel(:,:),   & 
     170         &                       z_fla(:,:), zmu(:,:), zthick(:,:), prho(:,:) ) 
     171      ! 
    202172   END SUBROUTINE diurnal_sst_takaya_step 
    203173 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r9161 r9168  
    284284      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 
    285285901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp ) 
    286       ! 
    287286      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run 
    288287      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) 
    289 902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp ) 
     288902   IF( ios > 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp ) 
    290289      IF(lwm) WRITE ( numond, namrun ) 
    291290      ! 
     
    335334      nwrite = nn_write 
    336335      neuler = nn_euler 
    337       IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN 
    338          WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 ' 
    339          CALL ctl_warn( ctmp1 ) 
     336      IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN 
     337         IF(lwp) WRITE(numout,*)   
     338         IF(lwp) WRITE(numout,*)'   Start from rest (ln_rstart=F) ==>>> an Euler initial time step is used,' 
     339         IF(lwp) WRITE(numout,*)'                                       nn_euler is forced to 0 '    
    340340         neuler = 0 
    341341      ENDIF 
     
    372372      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep) 
    373373      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 
    374 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 
    375       ! 
     374903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 
    376375      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 
    377376      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 
    378 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
     377904   IF( ios >  0 )  CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
    379378      IF(lwm) WRITE ( numond, namdom ) 
    380379      ! 
     
    405404      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 
    406405907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp ) 
    407       ! 
    408406      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF 
    409407      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 ) 
    410 908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp ) 
     408908   IF( ios > 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp ) 
    411409      IF(lwm) WRITE( numond, namnc4 ) 
    412410 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r9124 r9168  
    105105      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition 
    106106      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 ) 
    107 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlbc in reference namelist', lwp ) 
    108  
     107901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlbc in reference namelist', lwp ) 
    109108      REWIND( numnam_cfg )              ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition 
    110109      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 ) 
    111 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlbc in configuration namelist', lwp ) 
     110902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namlbc in configuration namelist', lwp ) 
    112111      IF(lwm) WRITE ( numond, namlbc ) 
    113112       
     
    151150      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries 
    152151      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 
    153 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
    154  
     152903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
    155153      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries 
    156154      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 ) 
    157 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
     155904   IF( ios >  0 )  CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
    158156      ! ------------------------ 
    159157      IF ( ln_bdy .AND. ln_mask_file ) THEN 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r9124 r9168  
    966966      REWIND( numnam_ref )              ! Namelist nam_vvl in reference namelist :  
    967967      READ  ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901) 
    968 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in reference namelist', lwp ) 
    969       ! 
     968901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_vvl in reference namelist', lwp ) 
    970969      REWIND( numnam_cfg )              ! Namelist nam_vvl in configuration namelist : Parameters of the run 
    971970      READ  ( numnam_cfg, nam_vvl, IOSTAT = ios, ERR = 902 ) 
    972 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in configuration namelist', lwp ) 
     971902   IF( ios > 0 ) CALL ctl_nam ( ios , 'nam_vvl in configuration namelist', lwp ) 
    973972      IF(lwm) WRITE ( numond, nam_vvl ) 
    974973      ! 
     
    977976         WRITE(numout,*) 'dom_vvl_ctl : choice/control of the variable vertical coordinate' 
    978977         WRITE(numout,*) '~~~~~~~~~~~' 
    979          WRITE(numout,*) '           Namelist nam_vvl : chose a vertical coordinate' 
    980          WRITE(numout,*) '              zstar                      ln_vvl_zstar   = ', ln_vvl_zstar 
    981          WRITE(numout,*) '              ztilde                     ln_vvl_ztilde  = ', ln_vvl_ztilde 
    982          WRITE(numout,*) '              layer                      ln_vvl_layer   = ', ln_vvl_layer 
    983          WRITE(numout,*) '              ztilde as zstar   ln_vvl_ztilde_as_zstar  = ', ln_vvl_ztilde_as_zstar 
     978         WRITE(numout,*) '   Namelist nam_vvl : chose a vertical coordinate' 
     979         WRITE(numout,*) '      zstar                      ln_vvl_zstar   = ', ln_vvl_zstar 
     980         WRITE(numout,*) '      ztilde                     ln_vvl_ztilde  = ', ln_vvl_ztilde 
     981         WRITE(numout,*) '      layer                      ln_vvl_layer   = ', ln_vvl_layer 
     982         WRITE(numout,*) '      ztilde as zstar   ln_vvl_ztilde_as_zstar  = ', ln_vvl_ztilde_as_zstar 
    984983         WRITE(numout,*) '      ztilde near the equator    ln_vvl_zstar_at_eqtor  = ', ln_vvl_zstar_at_eqtor 
    985          ! WRITE(numout,*) '           Namelist nam_vvl : chose kinetic-to-potential energy conservation' 
    986          ! WRITE(numout,*) '                                         ln_vvl_kepe    = ', ln_vvl_kepe 
    987          WRITE(numout,*) '           Namelist nam_vvl : thickness diffusion coefficient' 
    988          WRITE(numout,*) '                                         rn_ahe3        = ', rn_ahe3 
    989          WRITE(numout,*) '           Namelist nam_vvl : maximum e3t deformation fractional change' 
    990          WRITE(numout,*) '                                         rn_zdef_max    = ', rn_zdef_max 
     984         WRITE(numout,*) '      !' 
     985         WRITE(numout,*) '      thickness diffusion coefficient                      rn_ahe3      = ', rn_ahe3 
     986         WRITE(numout,*) '      maximum e3t deformation fractional change            rn_zdef_max  = ', rn_zdef_max 
    991987         IF( ln_vvl_ztilde_as_zstar ) THEN 
    992             WRITE(numout,*) '           ztilde running in zstar emulation mode; ' 
    993             WRITE(numout,*) '           ignoring namelist timescale parameters and using:' 
    994             WRITE(numout,*) '                 hard-wired : z-tilde to zstar restoration timescale (days)' 
    995             WRITE(numout,*) '                                         rn_rst_e3t     =    0.0' 
    996             WRITE(numout,*) '                 hard-wired : z-tilde cutoff frequency of low-pass filter (days)' 
    997             WRITE(numout,*) '                                         rn_lf_cutoff   =    1.0/rdt' 
     988            WRITE(numout,*) '      ztilde running in zstar emulation mode (ln_vvl_ztilde_as_zstar=T) ' 
     989            WRITE(numout,*) '         ignoring namelist timescale parameters and using:' 
     990            WRITE(numout,*) '            hard-wired : z-tilde to zstar restoration timescale (days)' 
     991            WRITE(numout,*) '                         rn_rst_e3t     = 0.e0' 
     992            WRITE(numout,*) '            hard-wired : z-tilde cutoff frequency of low-pass filter (days)' 
     993            WRITE(numout,*) '                         rn_lf_cutoff   = 1.0/rdt' 
    998994         ELSE 
    999             WRITE(numout,*) '           Namelist nam_vvl : z-tilde to zstar restoration timescale (days)' 
    1000             WRITE(numout,*) '                                         rn_rst_e3t     = ', rn_rst_e3t 
    1001             WRITE(numout,*) '           Namelist nam_vvl : z-tilde cutoff frequency of low-pass filter (days)' 
    1002             WRITE(numout,*) '                                         rn_lf_cutoff   = ', rn_lf_cutoff 
     995            WRITE(numout,*) '      z-tilde to zstar restoration timescale (days)        rn_rst_e3t   = ', rn_rst_e3t 
     996            WRITE(numout,*) '      z-tilde cutoff frequency of low-pass filter (days)   rn_lf_cutoff = ', rn_lf_cutoff 
    1003997         ENDIF 
    1004          WRITE(numout,*) '           Namelist nam_vvl : debug prints' 
    1005          WRITE(numout,*) '                                         ln_vvl_dbg     = ', ln_vvl_dbg 
     998         WRITE(numout,*) '         debug prints flag                                 ln_vvl_dbg   = ', ln_vvl_dbg 
    1006999      ENDIF 
    10071000      ! 
     
    10171010      IF(lwp) THEN                   ! Print the choice 
    10181011         WRITE(numout,*) 
    1019          IF( ln_vvl_zstar           ) WRITE(numout,*) '              zstar vertical coordinate is used' 
    1020          IF( ln_vvl_ztilde          ) WRITE(numout,*) '              ztilde vertical coordinate is used' 
    1021          IF( ln_vvl_layer           ) WRITE(numout,*) '              layer vertical coordinate is used' 
    1022          IF( ln_vvl_ztilde_as_zstar ) WRITE(numout,*) '              to emulate a zstar coordinate' 
    1023          ! - ML - Option not developed yet 
    1024          ! IF(       ln_vvl_kepe ) WRITE(numout,*) '              kinetic to potential energy transfer : option used' 
    1025          ! IF( .NOT. ln_vvl_kepe ) WRITE(numout,*) '              kinetic to potential energy transfer : option not used' 
     1012         IF( ln_vvl_zstar           ) WRITE(numout,*) '      ==>>>   zstar vertical coordinate is used' 
     1013         IF( ln_vvl_ztilde          ) WRITE(numout,*) '      ==>>>   ztilde vertical coordinate is used' 
     1014         IF( ln_vvl_layer           ) WRITE(numout,*) '      ==>>>   layer vertical coordinate is used' 
     1015         IF( ln_vvl_ztilde_as_zstar ) WRITE(numout,*) '      ==>>>   to emulate a zstar coordinate' 
    10261016      ENDIF 
    10271017      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r9124 r9168  
    6666      REWIND( numnam_ref )              ! Namelist namtsd in reference namelist :  
    6767      READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901) 
    68 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in reference namelist', lwp ) 
    69  
     68901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtsd in reference namelist', lwp ) 
    7069      REWIND( numnam_cfg )              ! Namelist namtsd in configuration namelist : Parameters of the run 
    7170      READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 ) 
    72 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in configuration namelist', lwp ) 
     71902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namtsd in configuration namelist', lwp ) 
    7372      IF(lwm) WRITE ( numond, namtsd ) 
    7473 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90

    r9019 r9168  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  sbciscpl  *** 
    4    !! Ocean forcing:  river runoff 
     4   !! Ocean forcing:  ????? 
    55   !!===================================================================== 
    66   !! History :  NEMO  ! 2015-01 P. Mathiot: original  
     
    2323   PUBLIC   iscpl_init       
    2424   PUBLIC   iscpl_alloc  
    25    !!                                                      !!* namsbc_iscpl namelist * 
    26    LOGICAL , PUBLIC                                        ::   ln_hsb 
    27    INTEGER , PUBLIC                                        ::   nn_fiscpl, nstp_iscpl 
    28    INTEGER , PUBLIC                                        ::   nn_drown 
    29    REAL(wp), PUBLIC                                        ::   rdt_iscpl 
    30    !!                                                      !!* namsbc_iscpl namelist * 
    31    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::   hdiv_iscpl 
    32    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   htsc_iscpl 
     25    
     26   !                                 !!* namsbc_iscpl namelist * 
     27   LOGICAL , PUBLIC ::   ln_hsb       !: 
     28   INTEGER , PUBLIC ::   nn_fiscpl    !: 
     29   INTEGER , PUBLIC ::   nn_drown     !: 
     30    
     31   INTEGER , PUBLIC ::   nstp_iscpl   !: 
     32   REAL(wp), PUBLIC ::   rdt_iscpl    !:  
     33   ! 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hdiv_iscpl   !: 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   htsc_iscpl   !: 
     36 
    3337   !!---------------------------------------------------------------------- 
    34    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    35    !! $Id: sbcrnf.F90 4666 2014-06-11 12:52:23Z mathiot $ 
     38   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
     39   !! $Id:$ 
    3640   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3741   !!---------------------------------------------------------------------- 
     
    5155   SUBROUTINE iscpl_init() 
    5256      !!---------------------------------------------------------------------- 
     57      !!---------------------------------------------------------------------- 
    5358      INTEGER ::   ios           ! Local integer output status for namelist read 
    5459      NAMELIST/namsbc_iscpl/ nn_fiscpl, ln_hsb, nn_drown 
     
    5964      REWIND( numnam_ref )              ! Namelist namsbc_iscpl in reference namelist : Ice sheet coupling 
    6065      READ  ( numnam_ref, namsbc_iscpl, IOSTAT = ios, ERR = 901) 
    61 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iscpl in reference namelist', lwp ) 
    62  
     66901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_iscpl in reference namelist', lwp ) 
    6367      REWIND( numnam_cfg )              ! Namelist namsbc_iscpl in configuration namelist : Ice Sheet coupling 
    6468      READ  ( numnam_cfg, namsbc_iscpl, IOSTAT = ios, ERR = 902 ) 
    65 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', lwp ) 
    6670      IF(lwm) WRITE ( numond, namsbc_iscpl ) 
    6771      ! 
    68       nstp_iscpl=MIN(nn_fiscpl, nitend-nit000+1) ! the coupling period have to be less or egal than the total number of time step 
     72      nstp_iscpl=MIN( nn_fiscpl, nitend-nit000+1 ) ! the coupling period have to be less or egal than the total number of time step 
    6973      rdt_iscpl = nstp_iscpl * rn_rdt 
    7074      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90

    r9019 r9168  
    100100      REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme 
    101101      READ  ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901) 
    102 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp ) 
    103       ! 
     102901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp ) 
    104103      REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme 
    105104      READ  ( numnam_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 ) 
    106 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp ) 
     105902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp ) 
    107106      IF(lwm) WRITE ( numond, namdyn_adv ) 
    108107 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r9090 r9168  
    147147      REWIND( numnam_cfg )              ! Namelist namdyn_hpg in configuration namelist : Hydrostatic pressure gradient 
    148148      READ  ( numnam_cfg, namdyn_hpg, IOSTAT = ios, ERR = 902 ) 
    149 902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist', lwp ) 
     149902   IF( ios > 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist', lwp ) 
    150150      IF(lwm) WRITE ( numond, namdyn_hpg ) 
    151151      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r9124 r9168  
    200200      REWIND( numnam_cfg )              ! Namelist namdyn_spg in configuration namelist : Free surface 
    201201      READ  ( numnam_cfg, namdyn_spg, IOSTAT = ios, ERR = 902 ) 
    202 902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist', lwp ) 
     202902   IF( ios > 0 )   CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist', lwp ) 
    203203      IF(lwm) WRITE ( numond, namdyn_spg ) 
    204204      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r9124 r9168  
    560560      REWIND( numnam_ref )              ! Namelist namdyn_vor in reference namelist : Vorticity scheme options 
    561561      READ  ( numnam_ref, namdyn_vor, IOSTAT = ios, ERR = 901) 
    562 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_vor in reference namelist', lwp ) 
    563  
     562901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_vor in reference namelist', lwp ) 
    564563      REWIND( numnam_cfg )              ! Namelist namdyn_vor in configuration namelist : Vorticity scheme options 
    565564      READ  ( numnam_cfg, namdyn_vor, IOSTAT = ios, ERR = 902 ) 
    566 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_vor in configuration namelist', lwp ) 
     565902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namdyn_vor in configuration namelist', lwp ) 
    567566      IF(lwm) WRITE ( numond, namdyn_vor ) 
    568567 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90

    r9124 r9168  
    7979      REWIND( numnam_ref )              ! Namelist namwad in reference namelist : Parameters for Wetting/Drying 
    8080      READ  ( numnam_ref, namwad, IOSTAT = ios, ERR = 905) 
    81 905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in reference namelist', .TRUE.)  
     81905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namwad in reference namelist', .TRUE.)  
    8282      REWIND( numnam_cfg )              ! Namelist namwad in configuration namelist : Parameters for Wetting/Drying 
    8383      READ  ( numnam_cfg, namwad, IOSTAT = ios, ERR = 906) 
    84 906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in configuration namelist', .TRUE. ) 
     84906   IF( ios >  0 )  CALL ctl_nam ( ios , 'namwad in configuration namelist', .TRUE. ) 
    8585      IF(lwm) WRITE ( numond, namwad ) 
    8686      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90

    r9124 r9168  
    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', lwp ) 
    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', lwp ) 
    9797      IF(lwm) WRITE ( numond, namflo ) 
    9898      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90

    r7753 r9168  
    367367      REWIND( numnam_cfg )              ! Namelist namberg in configuration namelist : Iceberg parameters 
    368368      READ  ( numnam_cfg, namberg, IOSTAT = ios, ERR = 902 ) 
    369 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namberg in configuration namelist', lwp ) 
     369902   IF( ios > 0 ) CALL ctl_nam ( ios , 'namberg in configuration namelist', lwp ) 
    370370      IF(lwm) WRITE ( numond, namberg ) 
    371371#else 
     
    387387      ENDIF 
    388388 
    389       IF( nn_test_icebergs > nclasses ) THEN 
    390           IF(lwp) WRITE(numout,*) 'Resetting nn_test_icebergs to ', nclasses 
    391           nn_test_icebergs = nclasses 
    392       ENDIF 
    393  
    394       zfact = SUM( rn_distribution ) 
    395       IF( zfact < 1._wp ) THEN 
    396          IF( zfact <= 0._wp ) THEN 
    397              
    398          ELSE 
    399             rn_distribution(:) = rn_distribution(:) / zfact 
    400             CALL ctl_warn( 'icb_nam: sum of berg input distribution not equal to one and so RESCALED' ) 
    401          ENDIF 
    402       ENDIF 
    403389 
    404390!     IF( lk_lim3 .AND. ln_icebergs ) THEN 
     
    418404         WRITE(numout,*) '   Fraction of calving to apply to this class (non-dim)         rn_distribution     =' 
    419405         DO jn = 1, nclasses 
    420             WRITE(numout,'(a,f10.2)') '                                                                ',rn_distribution(jn) 
     406            WRITE(numout,'(a,f10.4)') '                                                                ',rn_distribution(jn) 
    421407         END DO 
    422408         WRITE(numout,*) '   Ratio between effective and real iceberg mass (non-dim)      rn_mass_scaling     = ' 
     
    449435      ENDIF 
    450436      ! 
     437      IF( nn_test_icebergs > nclasses ) THEN 
     438         IF(lwp) WRITE(numout,*) '      ==>>>   Resetting of nn_test_icebergs to ', nclasses 
     439         nn_test_icebergs = nclasses 
     440      ENDIF 
     441 
     442      ! ensure that the sum of berg input distribution is equal to one 
     443      zfact = SUM( rn_distribution ) 
     444      IF( zfact /= 1._wp .AND. 0_wp /= zfact ) THEN 
     445         rn_distribution(:) = rn_distribution(:) / zfact 
     446         IF(lwp) THEN 
     447            WRITE(numout,*) 
     448            WRITE(numout,*) '      ==>>> CAUTION:    sum of berg input distribution = ', zfact 
     449            WRITE(numout,*) '            *******     redistribution has been rescaled' 
     450            WRITE(numout,*) '                        updated berg distribution is :' 
     451            DO jn = 1, nclasses 
     452               WRITE(numout,'(a,f10.4)') '                                   ',rn_distribution(jn) 
     453            END DO 
     454         ENDIF 
     455      ENDIF 
     456      IF( MINVAL( rn_distribution(:) ) < 0._wp ) THEN 
     457         CALL ctl_stop( 'icb_nam: a negative rn_distribution value encountered ==>> change your namelist namberg' ) 
     458      ENDIF 
     459      ! 
    451460   END SUBROUTINE icb_nam 
    452461 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r9125 r9168  
    203203      REWIND( kumnam_ref )              ! Namelist nammpp in reference namelist: mpi variables 
    204204      READ  ( kumnam_ref, nammpp, IOSTAT = ios, ERR = 901) 
    205 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp ) 
     205901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp ) 
    206206      ! 
    207207      REWIND( kumnam_cfg )              ! Namelist nammpp in configuration namelist: mpi variables 
    208208      READ  ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 ) 
    209 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp ) 
     209902   IF( ios >  0 )  CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp ) 
    210210      ! 
    211211      !                              ! control print 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r9069 r9168  
    556556      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist : BDY 
    557557      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 
    558 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)', lwp ) 
    559  
     558903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)', lwp ) 
     559      ! 
    560560      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist : BDY 
    561561      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 ) 
    562 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)', lwp ) 
     562904   IF( ios >  0 )  CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)', lwp ) 
    563563 
    564564      IF( ln_bdy .AND. ln_mask_file ) THEN 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r9094 r9168  
    104104      REWIND( numnam_ref )              ! Namelist namdyn_ldf in reference namelist : Lateral physics 
    105105      READ  ( numnam_ref, namdyn_ldf, IOSTAT = ios, ERR = 901) 
    106 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_ldf in reference namelist', lwp ) 
     106901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_ldf in reference namelist', lwp ) 
    107107 
    108108      REWIND( numnam_cfg )              ! Namelist namdyn_ldf in configuration namelist : Lateral physics 
    109109      READ  ( numnam_cfg, namdyn_ldf, IOSTAT = ios, ERR = 902 ) 
    110 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_ldf in configuration namelist', lwp ) 
     110902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namdyn_ldf in configuration namelist', lwp ) 
    111111      IF(lwm) WRITE ( numond, namdyn_ldf ) 
    112112 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r9124 r9168  
    131131      REWIND( numnam_ref )              ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers 
    132132      READ  ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901) 
    133 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp ) 
     133901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp ) 
    134134      ! 
    135135      REWIND( numnam_cfg )              ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers 
    136136      READ  ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 ) 
    137 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp ) 
     137902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp ) 
    138138      IF(lwm) WRITE ( numond, namtra_ldf ) 
    139139      ! 
     
    384384      REWIND( numnam_ref )              ! Namelist namtra_ldfeiv in reference namelist : eddy induced velocity param. 
    385385      READ  ( numnam_ref, namtra_ldfeiv, IOSTAT = ios, ERR = 901) 
    386 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in reference namelist', lwp ) 
     386901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_ldfeiv in reference namelist', lwp ) 
    387387      ! 
    388388      REWIND( numnam_cfg )              ! Namelist namtra_ldfeiv in configuration namelist : eddy induced velocity param. 
    389389      READ  ( numnam_cfg, namtra_ldfeiv, IOSTAT = ios, ERR = 902 ) 
    390 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in configuration namelist', lwp ) 
     390902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namtra_ldfeiv in configuration namelist', lwp ) 
    391391      IF(lwm)  WRITE ( numond, namtra_ldfeiv ) 
    392392 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r9125 r9168  
    55   !!                          their model equivalent  
    66   !!====================================================================== 
    7  
     7   !! History :  1.0  !  2006-03  (K. Mogensen) Original code 
     8   !!             -   !  2006-05  (K. Mogensen, A. Weaver) Reformatted 
     9   !!             -   !  2006-10  (A. Weaver) Cleaning and add controls 
     10   !!             -   !  2007-03  (K. Mogensen) General handling of profiles 
     11   !!             -   !  2007-04  (G. Smith) Generalized surface operators 
     12   !!            2.0  !  2008-10  (M. Valdivieso) obs operator for velocity profiles 
     13   !!            3.4  !  2014-08  (J. While) observation operator for profiles in all vertical coordinates 
     14   !!             -   !                      Incorporated SST bias correction   
     15   !!            3.6  !  2015-02  (M. Martin) Simplification of namelist and code 
     16   !!             -   !  2015-08  (M. Martin) Combined surface/profile routines. 
     17   !!            4.0  !  2017-11  (G. Madec) style only 
    818   !!---------------------------------------------------------------------- 
    9    !!   dia_obs_init : Reading and prepare observations 
    10    !!   dia_obs      : Compute model equivalent to observations 
    11    !!   dia_obs_wri  : Write observational diagnostics 
    12    !!   calc_date    : Compute the date of timestep in YYYYMMDD.HHMMSS format 
    13    !!   ini_date     : Compute the initial date YYYYMMDD.HHMMSS 
    14    !!   fin_date     : Compute the final date YYYYMMDD.HHMMSS 
     19 
    1520   !!---------------------------------------------------------------------- 
    16    USE par_kind                 ! Precision variables 
    17    USE in_out_manager           ! I/O manager 
    18    USE par_oce 
    19    USE dom_oce                  ! Ocean space and time domain variables 
    20    USE obs_read_prof            ! Reading and allocation of profile obs 
    21    USE obs_read_surf            ! Reading and allocation of surface obs 
    22    USE obs_sstbias              ! Bias correction routine for SST  
    23    USE obs_readmdt              ! Reading and allocation of MDT for SLA. 
    24    USE obs_prep                 ! Preparation of obs. (grid search etc). 
    25    USE obs_oper                 ! Observation operators 
    26    USE obs_write                ! Writing of observation related diagnostics 
    27    USE obs_grid                 ! Grid searching 
    28    USE obs_read_altbias         ! Bias treatment for altimeter 
    29    USE obs_profiles_def         ! Profile data definitions 
    30    USE obs_surf_def             ! Surface data definitions 
    31    USE obs_types                ! Definitions for observation types 
    32    USE mpp_map                  ! MPP mapping 
    33    USE sbc_oce                  ! Sea-ice fraction 
    34    USE lib_mpp                  ! For ctl_warn/stop 
     21   !!   dia_obs_init  : Reading and prepare observations 
     22   !!   dia_obs       : Compute model equivalent to observations 
     23   !!   dia_obs_wri   : Write observational diagnostics 
     24   !!   calc_date     : Compute the date of timestep in YYYYMMDD.HHMMSS format 
     25   !!   ini_date      : Compute the initial date YYYYMMDD.HHMMSS 
     26   !!   fin_date      : Compute the final date YYYYMMDD.HHMMSS 
     27   !!---------------------------------------------------------------------- 
     28   USE par_kind       ! Precision variables 
     29   USE in_out_manager ! I/O manager 
     30   USE par_oce        ! ocean parameter 
     31   USE dom_oce        ! Ocean space and time domain variables 
     32   USE sbc_oce        ! Sea-ice fraction 
     33   ! 
     34   USE obs_read_prof  ! Reading and allocation of profile obs 
     35   USE obs_read_surf  ! Reading and allocation of surface obs 
     36   USE obs_sstbias    ! Bias correction routine for SST  
     37   USE obs_readmdt    ! Reading and allocation of MDT for SLA. 
     38   USE obs_prep       ! Preparation of obs. (grid search etc). 
     39   USE obs_oper       ! Observation operators 
     40   USE obs_write      ! Writing of observation related diagnostics 
     41   USE obs_grid       ! Grid searching 
     42   USE obs_read_altbias ! Bias treatment for altimeter 
     43   USE obs_profiles_def ! Profile data definitions 
     44   USE obs_surf_def   ! Surface data definitions 
     45   USE obs_types      ! Definitions for observation types 
     46   ! 
     47   USE mpp_map        ! MPP mapping 
     48   USE lib_mpp        ! For ctl_warn/stop 
    3549 
    3650   IMPLICIT NONE 
     
    4357   PUBLIC calc_date        ! Compute the date of a timestep 
    4458 
    45    !! * Module variables 
    46    LOGICAL, PUBLIC :: ln_diaobs   !: Logical switch for the obs operator 
    47    LOGICAL :: ln_sstnight         !: Logical switch for night mean SST obs 
    48    LOGICAL :: ln_sla_fp_indegs    !: T=> SLA obs footprint size specified in degrees, F=> in metres 
    49    LOGICAL :: ln_sst_fp_indegs    !: T=> SST obs footprint size specified in degrees, F=> in metres 
    50    LOGICAL :: ln_sss_fp_indegs    !: T=> SSS obs footprint size specified in degrees, F=> in metres 
    51    LOGICAL :: ln_sic_fp_indegs    !: T=> sea-ice obs footprint size specified in degrees, F=> in metres 
    52  
    53    REAL(wp) :: rn_sla_avglamscl !: E/W diameter of SLA observation footprint (metres) 
    54    REAL(wp) :: rn_sla_avgphiscl !: N/S diameter of SLA observation footprint (metres) 
    55    REAL(wp) :: rn_sst_avglamscl !: E/W diameter of SST observation footprint (metres) 
    56    REAL(wp) :: rn_sst_avgphiscl !: N/S diameter of SST observation footprint (metres) 
    57    REAL(wp) :: rn_sss_avglamscl !: E/W diameter of SSS observation footprint (metres) 
    58    REAL(wp) :: rn_sss_avgphiscl !: N/S diameter of SSS observation footprint (metres) 
    59    REAL(wp) :: rn_sic_avglamscl !: E/W diameter of sea-ice observation footprint (metres) 
    60    REAL(wp) :: rn_sic_avgphiscl !: N/S diameter of sea-ice observation footprint (metres) 
    61  
    62    INTEGER :: nn_1dint       !: Vertical interpolation method 
    63    INTEGER :: nn_2dint       !: Default horizontal interpolation method 
    64    INTEGER :: nn_2dint_sla   !: SLA horizontal interpolation method  
    65    INTEGER :: nn_2dint_sst   !: SST horizontal interpolation method  
    66    INTEGER :: nn_2dint_sss   !: SSS horizontal interpolation method  
    67    INTEGER :: nn_2dint_sic   !: Seaice horizontal interpolation method  
    68    INTEGER, DIMENSION(imaxavtypes) ::   nn_profdavtypes   !: Profile data types representing a daily average 
    69    INTEGER :: nproftypes     !: Number of profile obs types 
    70    INTEGER :: nsurftypes     !: Number of surface obs types 
    71    INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    72       & nvarsprof, &         !: Number of profile variables 
    73       & nvarssurf            !: Number of surface variables 
    74    INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    75       & nextrprof, &         !: Number of profile extra variables 
    76       & nextrsurf            !: Number of surface extra variables 
    77    INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    78       & n2dintsurf           !: Interpolation option for surface variables 
    79    REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    80       & zavglamscl, &        !: E/W diameter of averaging footprint for surface variables 
    81       & zavgphiscl           !: N/S diameter of averaging footprint for surface variables 
    82    LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
    83       & lfpindegs, &         !: T=> surface obs footprint size specified in degrees, F=> in metres 
    84       & llnightav            !: Logical for calculating night-time averages 
    85  
    86    TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: & 
    87       & surfdata, &          !: Initial surface data 
    88       & surfdataqc           !: Surface data after quality control 
    89    TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: & 
    90       & profdata, &          !: Initial profile data 
    91       & profdataqc           !: Profile data after quality control 
     59   LOGICAL, PUBLIC :: ln_diaobs          !: Logical switch for the obs operator 
     60   LOGICAL         :: ln_sstnight        !  Logical switch for night mean SST obs 
     61   LOGICAL         :: ln_sla_fp_indegs   !  T=> SLA obs footprint size specified in degrees, F=> in metres 
     62   LOGICAL         :: ln_sst_fp_indegs   !  T=> SST obs footprint size specified in degrees, F=> in metres 
     63   LOGICAL         :: ln_sss_fp_indegs   !  T=> SSS obs footprint size specified in degrees, F=> in metres 
     64   LOGICAL         :: ln_sic_fp_indegs   !  T=> sea-ice obs footprint size specified in degrees, F=> in metres 
     65 
     66   REAL(wp) ::   rn_sla_avglamscl   ! E/W diameter of SLA observation footprint (metres) 
     67   REAL(wp) ::   rn_sla_avgphiscl   ! N/S diameter of SLA observation footprint (metres) 
     68   REAL(wp) ::   rn_sst_avglamscl   ! E/W diameter of SST observation footprint (metres) 
     69   REAL(wp) ::   rn_sst_avgphiscl   ! N/S diameter of SST observation footprint (metres) 
     70   REAL(wp) ::   rn_sss_avglamscl   ! E/W diameter of SSS observation footprint (metres) 
     71   REAL(wp) ::   rn_sss_avgphiscl   ! N/S diameter of SSS observation footprint (metres) 
     72   REAL(wp) ::   rn_sic_avglamscl   ! E/W diameter of sea-ice observation footprint (metres) 
     73   REAL(wp) ::   rn_sic_avgphiscl   ! N/S diameter of sea-ice observation footprint (metres) 
     74 
     75   INTEGER :: nn_1dint       ! Vertical interpolation method 
     76   INTEGER :: nn_2dint       ! Default horizontal interpolation method 
     77   INTEGER :: nn_2dint_sla   ! SLA horizontal interpolation method  
     78   INTEGER :: nn_2dint_sst   ! SST horizontal interpolation method  
     79   INTEGER :: nn_2dint_sss   ! SSS horizontal interpolation method  
     80   INTEGER :: nn_2dint_sic   ! Seaice horizontal interpolation method  
     81   INTEGER, DIMENSION(imaxavtypes) ::   nn_profdavtypes   ! Profile data types representing a daily average 
     82   INTEGER :: nproftypes     ! Number of profile obs types 
     83   INTEGER :: nsurftypes     ! Number of surface obs types 
     84   INTEGER , DIMENSION(:), ALLOCATABLE ::   nvarsprof, nvarssurf   ! Number of profile & surface variables 
     85   INTEGER , DIMENSION(:), ALLOCATABLE ::   nextrprof, nextrsurf   ! Number of profile & surface extra variables 
     86   INTEGER , DIMENSION(:), ALLOCATABLE ::   n2dintsurf             ! Interpolation option for surface variables 
     87   REAL(wp), DIMENSION(:), ALLOCATABLE ::   zavglamscl, zavgphiscl ! E/W & N/S diameter of averaging footprint for surface variables 
     88   LOGICAL , DIMENSION(:), ALLOCATABLE ::   lfpindegs              ! T=> surface obs footprint size specified in degrees, F=> in metres 
     89   LOGICAL , DIMENSION(:), ALLOCATABLE ::   llnightav              ! Logical for calculating night-time averages 
     90 
     91   TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) ::   surfdata     !: Initial surface data 
     92   TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) ::   surfdataqc   !: Surface data after quality control 
     93   TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) ::   profdata     !: Initial profile data 
     94   TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) ::   profdataqc   !: Profile data after quality control 
    9295 
    9396   CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE ::   cobstypesprof, cobstypessurf   !: Profile & surface obs types 
     
    110113      !! ** Action  : Read the namelist and call reading routines 
    111114      !! 
    112       !! History : 
    113       !!        !  06-03  (K. Mogensen) Original code 
    114       !!        !  06-05  (A. Weaver) Reformatted 
    115       !!        !  06-10  (A. Weaver) Cleaning and add controls 
    116       !!        !  07-03  (K. Mogensen) General handling of profiles 
    117       !!        !  14-08  (J.While) Incorporated SST bias correction   
    118       !!        !  15-02  (M. Martin) Simplification of namelist and code 
    119115      !!---------------------------------------------------------------------- 
    120116      INTEGER, PARAMETER ::   jpmaxnfiles = 1000    ! Maximum number of files for each obs type 
     
    124120      INTEGER :: jvar            ! Counter for variables 
    125121      INTEGER :: jfile           ! Counter for files 
    126  
     122      INTEGER :: jnumsstbias 
     123      ! 
    127124      CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: & 
    128125         & cn_profbfiles, &      ! T/S profile input filenames 
     
    138135         & clproffiles, &        ! Profile filenames 
    139136         & clsurffiles           ! Surface filenames 
    140  
     137         ! 
    141138      LOGICAL :: ln_t3d          ! Logical switch for temperature profiles 
    142139      LOGICAL :: ln_s3d          ! Logical switch for salinity profiles 
     
    155152      LOGICAL :: llvar2          ! Logical for profile variable 1 
    156153      LOGICAL, DIMENSION(jpmaxnfiles) :: lmask ! Used for finding number of sstbias files 
    157  
     154      ! 
    158155      REAL(dp) :: rn_dobsini     ! Obs window start date YYYYMMDD.HHMMSS 
    159156      REAL(dp) :: rn_dobsend     ! Obs window end date   YYYYMMDD.HHMMSS 
    160       REAL(wp), DIMENSION(jpi,jpj) :: & 
    161          & zglam1, &             ! Model longitudes for profile variable 1 
    162          & zglam2                ! Model longitudes for profile variable 2 
    163       REAL(wp), DIMENSION(jpi,jpj) :: & 
    164          & zgphi1, &             ! Model latitudes for profile variable 1 
    165          & zgphi2                ! Model latitudes for profile variable 2 
    166       REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 
    167          & zmask1, &             ! Model land/sea mask associated with variable 1 
    168          & zmask2                ! Model land/sea mask associated with variable 2 
    169  
     157      REAL(wp), DIMENSION(jpi,jpj)     ::   zglam1, zglam2   ! Model longitudes for profile variable 1 & 2 
     158      REAL(wp), DIMENSION(jpi,jpj)     ::   zgphi1, zgphi2   ! Model latitudes  for profile variable 1 & 2 
     159      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask1, zmask2   ! Model land/sea mask associated with variable 1 & 2 
     160      !! 
    170161      NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla,              & 
    171162         &            ln_sst, ln_sic, ln_sss, ln_vel3d,               & 
     
    191182         &            nn_msshc, rn_mdtcorr, rn_mdtcutoff,             & 
    192183         &            nn_profdavtypes 
    193  
    194       INTEGER :: jnumsstbias 
     184      !----------------------------------------------------------------------- 
    195185 
    196186      !----------------------------------------------------------------------- 
     
    198188      !----------------------------------------------------------------------- 
    199189      ! Some namelist arrays need initialising 
    200       cn_profbfiles(:) = '' 
    201       cn_slafbfiles(:) = '' 
    202       cn_sstfbfiles(:) = '' 
    203       cn_sicfbfiles(:) = '' 
    204       cn_velfbfiles(:) = '' 
    205       cn_sssfbfiles(:)    = '' 
     190      cn_profbfiles  (:) = '' 
     191      cn_slafbfiles  (:) = '' 
     192      cn_sstfbfiles  (:) = '' 
     193      cn_sicfbfiles  (:) = '' 
     194      cn_velfbfiles  (:) = '' 
     195      cn_sssfbfiles  (:) = '' 
    206196      cn_sstbiasfiles(:) = '' 
    207197      nn_profdavtypes(:) = -1 
     
    213203      REWIND( numnam_ref )   ! Namelist namobs in reference namelist 
    214204      READ  ( numnam_ref, namobs, IOSTAT = ios, ERR = 901) 
    215 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in reference namelist', lwp ) 
    216  
     205901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namobs in reference namelist', lwp ) 
    217206      REWIND( numnam_cfg )   ! Namelist namobs in configuration namelist 
    218207      READ  ( numnam_cfg, namobs, IOSTAT = ios, ERR = 902 ) 
    219 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', lwp ) 
    220209      IF(lwm) WRITE ( numond, namobs ) 
    221210 
    222       IF ( .NOT. ln_diaobs ) THEN 
    223          IF(lwp) WRITE(numout,cform_war) 
    224          IF(lwp) WRITE(numout,*)' ln_diaobs is set to false so not calling dia_obs' 
     211      IF( .NOT.ln_diaobs ) THEN 
     212         IF(lwp) WRITE(numout,*) 
     213         IF(lwp) WRITE(numout,*) 'dia_obs_init : NO Observation diagnostic used' 
     214         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    225215         RETURN 
    226216      ENDIF 
     
    230220         WRITE(numout,*) 'dia_obs_init : Observation diagnostic initialization' 
    231221         WRITE(numout,*) '~~~~~~~~~~~~' 
    232          WRITE(numout,*) '          Namelist namobs : set observation diagnostic parameters'  
    233          WRITE(numout,*) '             Logical switch for T profile observations                ln_t3d = ', ln_t3d 
    234          WRITE(numout,*) '             Logical switch for S profile observations                ln_s3d = ', ln_s3d 
    235          WRITE(numout,*) '             Logical switch for SLA observations                      ln_sla = ', ln_sla 
    236          WRITE(numout,*) '             Logical switch for SST observations                      ln_sst = ', ln_sst 
    237          WRITE(numout,*) '             Logical switch for Sea Ice observations                  ln_sic = ', ln_sic 
    238          WRITE(numout,*) '             Logical switch for velocity observations               ln_vel3d = ', ln_vel3d 
    239          WRITE(numout,*) '             Logical switch for SSS observations                      ln_sss = ', ln_sss 
    240          WRITE(numout,*) '             Global distribution of observations              ln_grid_global = ', ln_grid_global 
    241          WRITE(numout,*) '             Logical switch for obs grid search lookup ln_grid_search_lookup = ', ln_grid_search_lookup 
     222         WRITE(numout,*) '   Namelist namobs : set observation diagnostic parameters'  
     223         WRITE(numout,*) '      Logical switch for T profile observations                ln_t3d = ', ln_t3d 
     224         WRITE(numout,*) '      Logical switch for S profile observations                ln_s3d = ', ln_s3d 
     225         WRITE(numout,*) '      Logical switch for SLA observations                      ln_sla = ', ln_sla 
     226         WRITE(numout,*) '      Logical switch for SST observations                      ln_sst = ', ln_sst 
     227         WRITE(numout,*) '      Logical switch for Sea Ice observations                  ln_sic = ', ln_sic 
     228         WRITE(numout,*) '      Logical switch for velocity observations               ln_vel3d = ', ln_vel3d 
     229         WRITE(numout,*) '      Logical switch for SSS observations                      ln_sss = ', ln_sss 
     230         WRITE(numout,*) '      Global distribution of observations              ln_grid_global = ', ln_grid_global 
     231         WRITE(numout,*) '      Logical switch for obs grid search lookup ln_grid_search_lookup = ', ln_grid_search_lookup 
    242232         IF (ln_grid_search_lookup) & 
    243             WRITE(numout,*) '             Grid search lookup file header                cn_gridsearchfile = ', cn_gridsearchfile 
    244          WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS               rn_dobsini = ', rn_dobsini 
    245          WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS                 rn_dobsend = ', rn_dobsend 
    246          WRITE(numout,*) '             Type of vertical interpolation method                  nn_1dint = ', nn_1dint 
    247          WRITE(numout,*) '             Type of horizontal interpolation method                nn_2dint = ', nn_2dint 
    248          WRITE(numout,*) '             Rejection of observations near land switch               ln_nea = ', ln_nea 
    249          WRITE(numout,*) '             Rejection of obs near open bdys                 ln_bound_reject = ', ln_bound_reject 
    250          WRITE(numout,*) '             MSSH correction scheme                                 nn_msshc = ', nn_msshc 
    251          WRITE(numout,*) '             MDT  correction                                      rn_mdtcorr = ', rn_mdtcorr 
    252          WRITE(numout,*) '             MDT cutoff for computed correction                 rn_mdtcutoff = ', rn_mdtcutoff 
    253          WRITE(numout,*) '             Logical switch for alt bias                          ln_altbias = ', ln_altbias 
    254          WRITE(numout,*) '             Logical switch for sst bias                          ln_sstbias = ', ln_sstbias 
    255          WRITE(numout,*) '             Logical switch for ignoring missing files             ln_ignmis = ', ln_ignmis 
    256          WRITE(numout,*) '             Daily average types                             nn_profdavtypes = ', nn_profdavtypes 
    257          WRITE(numout,*) '             Logical switch for night-time SST obs               ln_sstnight = ', ln_sstnight 
     233            WRITE(numout,*) '      Grid search lookup file header                cn_gridsearchfile = ', cn_gridsearchfile 
     234         WRITE(numout,*) '      Initial date in window YYYYMMDD.HHMMSS               rn_dobsini = ', rn_dobsini 
     235         WRITE(numout,*) '      Final date in window YYYYMMDD.HHMMSS                 rn_dobsend = ', rn_dobsend 
     236         WRITE(numout,*) '      Type of vertical interpolation method                  nn_1dint = ', nn_1dint 
     237         WRITE(numout,*) '      Type of horizontal interpolation method                nn_2dint = ', nn_2dint 
     238         WRITE(numout,*) '      Rejection of observations near land switch               ln_nea = ', ln_nea 
     239         WRITE(numout,*) '      Rejection of obs near open bdys                 ln_bound_reject = ', ln_bound_reject 
     240         WRITE(numout,*) '      MSSH correction scheme                                 nn_msshc = ', nn_msshc 
     241         WRITE(numout,*) '      MDT  correction                                      rn_mdtcorr = ', rn_mdtcorr 
     242         WRITE(numout,*) '      MDT cutoff for computed correction                 rn_mdtcutoff = ', rn_mdtcutoff 
     243         WRITE(numout,*) '      Logical switch for alt bias                          ln_altbias = ', ln_altbias 
     244         WRITE(numout,*) '      Logical switch for sst bias                          ln_sstbias = ', ln_sstbias 
     245         WRITE(numout,*) '      Logical switch for ignoring missing files             ln_ignmis = ', ln_ignmis 
     246         WRITE(numout,*) '      Daily average types                             nn_profdavtypes = ', nn_profdavtypes 
     247         WRITE(numout,*) '      Logical switch for night-time SST obs               ln_sstnight = ', ln_sstnight 
    258248      ENDIF 
    259249      !----------------------------------------------------------------------- 
     
    265255      nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic, ln_sss /) ) 
    266256 
    267       IF (ln_sstbias) THEN  
     257      IF( ln_sstbias ) THEN  
    268258         lmask(:) = .FALSE.  
    269          WHERE (cn_sstbiasfiles(:) /= '') lmask(:) = .TRUE.  
     259         WHERE( cn_sstbiasfiles(:) /= '' )  lmask(:) = .TRUE.  
    270260         jnumsstbias = COUNT(lmask)  
    271261         lmask(:) = .FALSE.  
    272262      ENDIF       
    273263 
    274       IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN 
    275          IF(lwp) WRITE(numout,cform_war) 
    276          IF(lwp) WRITE(numout,*) ' ln_diaobs is set to true, but all obs operator logical flags', & 
    277             &                    ' ln_t3d, ln_s3d, ln_sla, ln_sst, ln_sic, ln_vel3d', & 
    278             &                    ' are set to .FALSE. so turning off calls to dia_obs' 
    279          nwarn = nwarn + 1 
     264      IF( nproftypes == 0 .AND. nsurftypes == 0 ) THEN 
     265         CALL ctl_warn( 'dia_obs_init: ln_diaobs is set to true, but all obs operator logical flags',   & 
     266            &           ' (ln_t3d, ln_s3d, ln_sla, ln_sst, ln_sic, ln_vel3d)',                          & 
     267            &           ' are set to .FALSE. so turning off calls to dia_obs'  ) 
    280268         ln_diaobs = .FALSE. 
    281269         RETURN 
    282270      ENDIF 
    283271 
    284       IF ( nproftypes > 0 ) THEN 
    285  
    286          ALLOCATE( cobstypesprof(nproftypes) ) 
    287          ALLOCATE( ifilesprof(nproftypes) ) 
    288          ALLOCATE( clproffiles(nproftypes,jpmaxnfiles) ) 
    289  
     272      IF( nproftypes > 0 ) THEN 
     273         ! 
     274         ALLOCATE( cobstypesprof(nproftypes)             ) 
     275         ALLOCATE( ifilesprof   (nproftypes)            ) 
     276         ALLOCATE( clproffiles  (nproftypes,jpmaxnfiles) ) 
     277         ! 
    290278         jtype = 0 
    291          IF (ln_t3d .OR. ln_s3d) THEN 
     279         IF( ln_t3d .OR. ln_s3d ) THEN 
    292280            jtype = jtype + 1 
    293281            CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'prof  ', & 
    294282               &                   cn_profbfiles, ifilesprof, cobstypesprof, clproffiles ) 
    295283         ENDIF 
    296          IF (ln_vel3d) THEN 
     284         IF( ln_vel3d ) THEN 
    297285            jtype = jtype + 1 
    298286            CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'vel   ', & 
    299287               &                   cn_velfbfiles, ifilesprof, cobstypesprof, clproffiles ) 
    300288         ENDIF 
    301  
    302       ENDIF 
    303  
    304       IF ( nsurftypes > 0 ) THEN 
    305  
    306          ALLOCATE( cobstypessurf(nsurftypes) ) 
    307          ALLOCATE( ifilessurf(nsurftypes) ) 
    308          ALLOCATE( clsurffiles(nsurftypes, jpmaxnfiles) ) 
    309          ALLOCATE(n2dintsurf(nsurftypes)) 
    310          ALLOCATE(zavglamscl(nsurftypes)) 
    311          ALLOCATE(zavgphiscl(nsurftypes)) 
    312          ALLOCATE(lfpindegs(nsurftypes)) 
    313          ALLOCATE(llnightav(nsurftypes)) 
    314  
     289         ! 
     290      ENDIF 
     291 
     292      IF( nsurftypes > 0 ) THEN 
     293         ! 
     294         ALLOCATE( cobstypessurf(nsurftypes)             ) 
     295         ALLOCATE( ifilessurf   (nsurftypes)            ) 
     296         ALLOCATE( clsurffiles  (nsurftypes,jpmaxnfiles) ) 
     297         ALLOCATE( n2dintsurf   (nsurftypes)             ) 
     298         ALLOCATE( zavglamscl   (nsurftypes)             ) 
     299         ALLOCATE( zavgphiscl   (nsurftypes)             ) 
     300         ALLOCATE( lfpindegs    (nsurftypes)             ) 
     301         ALLOCATE( llnightav    (nsurftypes)             ) 
     302         ! 
    315303         jtype = 0 
    316          IF (ln_sla) THEN 
     304         IF( ln_sla ) THEN 
    317305            jtype = jtype + 1 
    318306            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sla   ', & 
     
    325313               &                  lfpindegs, llnightav ) 
    326314         ENDIF 
    327          IF (ln_sst) THEN 
     315         IF( ln_sst ) THEN 
    328316            jtype = jtype + 1 
    329317            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sst   ', & 
     
    337325         ENDIF 
    338326#if defined key_lim3 || defined key_cice 
    339          IF (ln_sic) THEN 
     327         IF( ln_sic ) THEN 
    340328            jtype = jtype + 1 
    341329            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sic   ', & 
     
    349337         ENDIF 
    350338#endif 
    351          IF (ln_sss) THEN 
     339         IF( ln_sss ) THEN 
    352340            jtype = jtype + 1 
    353341            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sss   ', & 
     
    360348               &                  lfpindegs, llnightav ) 
    361349         ENDIF 
    362  
    363       ENDIF 
    364  
     350         ! 
     351      ENDIF 
    365352 
    366353 
     
    368355      ! Obs operator parameter checking and initialisations 
    369356      !----------------------------------------------------------------------- 
    370  
    371       IF ( ln_vel3d .AND. ( .NOT. ln_grid_global ) ) THEN 
     357      ! 
     358      IF( ln_vel3d  .AND.  .NOT.ln_grid_global ) THEN 
    372359         CALL ctl_stop( 'Velocity data only works with ln_grid_global=.true.' ) 
    373360         RETURN 
    374361      ENDIF 
    375  
    376       IF ( ln_grid_global ) THEN 
    377          CALL ctl_warn( 'ln_grid_global=T may cause memory issues when used with a large number of processors' ) 
    378       ENDIF 
    379  
    380       IF ( ( nn_1dint < 0 ) .OR. ( nn_1dint > 1 ) ) THEN 
    381          CALL ctl_stop(' Choice of vertical (1D) interpolation method', & 
    382             &                    ' is not available') 
    383       ENDIF 
    384  
    385       IF ( ( nn_2dint < 0 ) .OR. ( nn_2dint > 6 ) ) THEN 
    386          CALL ctl_stop(' Choice of horizontal (2D) interpolation method', & 
    387             &                    ' is not available') 
    388       ENDIF 
    389  
     362      ! 
     363      IF( ln_grid_global ) THEN 
     364         CALL ctl_warn( 'dia_obs_init: ln_grid_global=T may cause memory issues when used with a large number of processors' ) 
     365      ENDIF 
     366      ! 
     367      IF( nn_1dint < 0  .OR.  nn_1dint > 1 ) THEN 
     368         CALL ctl_stop('dia_obs_init: Choice of vertical (1D) interpolation method is not available') 
     369      ENDIF 
     370      ! 
     371      IF( nn_2dint < 0  .OR.  nn_2dint > 6  ) THEN 
     372         CALL ctl_stop('dia_obs_init: Choice of horizontal (2D) interpolation method is not available') 
     373      ENDIF 
     374      ! 
    390375      CALL obs_typ_init 
    391       IF(ln_grid_global) THEN 
    392          CALL mppmap_init 
    393       ENDIF 
    394  
     376      IF( ln_grid_global )   CALL mppmap_init 
     377      ! 
    395378      CALL obs_grid_setup( ) 
    396379 
     
    398381      ! Depending on switches read the various observation types 
    399382      !----------------------------------------------------------------------- 
    400  
    401       IF ( nproftypes > 0 ) THEN 
    402  
    403          ALLOCATE(profdata(nproftypes)) 
    404          ALLOCATE(profdataqc(nproftypes)) 
    405          ALLOCATE(nvarsprof(nproftypes)) 
    406          ALLOCATE(nextrprof(nproftypes)) 
    407  
     383      ! 
     384      IF( nproftypes > 0 ) THEN 
     385         ! 
     386         ALLOCATE( profdata  (nproftypes) , nvarsprof (nproftypes) ) 
     387         ALLOCATE( profdataqc(nproftypes) , nextrprof (nproftypes) ) 
     388         ! 
    408389         DO jtype = 1, nproftypes 
    409  
     390            ! 
    410391            nvarsprof(jtype) = 2 
    411392            IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN 
     
    431412               zmask2 = vmask 
    432413            ENDIF 
    433  
    434             !Read in profile or profile obs types 
     414            ! 
     415            ! Read in profile or profile obs types 
    435416            CALL obs_rea_prof( profdata(jtype), ifilesprof(jtype),       & 
    436417               &               clproffiles(jtype,1:ifilesprof(jtype)), & 
     
    439420               &               ln_ignmis, ln_s_at_t, .FALSE., & 
    440421               &               kdailyavtypes = nn_profdavtypes ) 
    441  
     422               ! 
    442423            DO jvar = 1, nvarsprof(jtype) 
    443424               CALL obs_prof_staend( profdata(jtype), jvar ) 
    444425            END DO 
    445  
     426            ! 
    446427            CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 
    447428               &               llvar1, llvar2, & 
     
    450431               &               ln_nea, ln_bound_reject, & 
    451432               &               kdailyavtypes = nn_profdavtypes ) 
    452  
    453433         END DO 
    454  
     434         ! 
    455435         DEALLOCATE( ifilesprof, clproffiles ) 
    456  
    457       ENDIF 
    458  
    459       IF ( nsurftypes > 0 ) THEN 
    460  
    461          ALLOCATE(surfdata(nsurftypes)) 
    462          ALLOCATE(surfdataqc(nsurftypes)) 
    463          ALLOCATE(nvarssurf(nsurftypes)) 
    464          ALLOCATE(nextrsurf(nsurftypes)) 
    465  
     436         ! 
     437      ENDIF 
     438      ! 
     439      IF( nsurftypes > 0 ) THEN 
     440         ! 
     441         ALLOCATE( surfdata  (nsurftypes) , nvarssurf(nsurftypes) ) 
     442         ALLOCATE( surfdataqc(nsurftypes) , nextrsurf(nsurftypes) ) 
     443         ! 
    466444         DO jtype = 1, nsurftypes 
    467  
     445            ! 
    468446            nvarssurf(jtype) = 1 
    469447            nextrsurf(jtype) = 0 
    470448            llnightav(jtype) = .FALSE. 
    471             IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2 
    472             IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) llnightav(jtype) = ln_sstnight 
    473  
    474             !Read in surface obs types 
     449            IF( TRIM(cobstypessurf(jtype)) == 'sla' )  nextrsurf(jtype) = 2 
     450            IF( TRIM(cobstypessurf(jtype)) == 'sst' )  llnightav(jtype) = ln_sstnight 
     451            ! 
     452            ! Read in surface obs types 
    475453            CALL obs_rea_surf( surfdata(jtype), ifilessurf(jtype), & 
    476454               &               clsurffiles(jtype,1:ifilessurf(jtype)), & 
    477455               &               nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, & 
    478456               &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype) ) 
    479  
     457               ! 
    480458            CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject ) 
    481  
    482             IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 
     459            ! 
     460            IF( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 
    483461               CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype) ) 
    484                IF ( ln_altbias ) & 
     462               IF( ln_altbias )  & 
    485463                  & CALL obs_rea_altbias ( surfdataqc(jtype), n2dintsurf(jtype), cn_altbiasfile ) 
    486464            ENDIF 
    487  
    488             IF ( TRIM(cobstypessurf(jtype)) == 'sst' .AND. ln_sstbias ) THEN 
     465            ! 
     466            IF( TRIM(cobstypessurf(jtype)) == 'sst' .AND. ln_sstbias ) THEN 
    489467               jnumsstbias = 0 
    490468               DO jfile = 1, jpmaxnfiles 
    491                   IF ( TRIM(cn_sstbiasfiles(jfile)) /= '' ) & 
    492                      &  jnumsstbias = jnumsstbias + 1 
     469                  IF( TRIM(cn_sstbiasfiles(jfile)) /= '' )   jnumsstbias = jnumsstbias + 1 
    493470               END DO 
    494                IF ( jnumsstbias == 0 ) THEN 
    495                   CALL ctl_stop("ln_sstbias set but no bias files to read in")     
    496                ENDIF 
    497  
    498                CALL obs_app_sstbias( surfdataqc(jtype), n2dintsurf(jtype), &  
    499                   &                  jnumsstbias, cn_sstbiasfiles(1:jnumsstbias) )  
    500  
     471               IF( jnumsstbias == 0 )   CALL ctl_stop("ln_sstbias set but no bias files to read in")     
     472               ! 
     473               CALL obs_app_sstbias( surfdataqc(jtype), n2dintsurf(jtype)             ,   &  
     474                  &                  jnumsstbias      , cn_sstbiasfiles(1:jnumsstbias) )  
    501475            ENDIF 
    502476         END DO 
    503  
     477         ! 
    504478         DEALLOCATE( ifilessurf, clsurffiles ) 
    505  
    506       ENDIF 
    507  
     479         ! 
     480      ENDIF 
     481      ! 
    508482   END SUBROUTINE dia_obs_init 
    509483 
     
    521495      !! 
    522496      !! ** Action  : 
    523       !! 
    524       !! History : 
    525       !!        !  06-03  (K. Mogensen) Original code 
    526       !!        !  06-05  (K. Mogensen) Reformatted 
    527       !!        !  06-10  (A. Weaver) Cleaning 
    528       !!        !  07-03  (K. Mogensen) General handling of profiles 
    529       !!        !  07-04  (G. Smith) Generalized surface operators 
    530       !!        !  08-10  (M. Valdivieso) obs operator for velocity profiles 
    531       !!        !  14-08  (J. While) observation operator for profiles in  
    532       !!                             generalised vertical coordinates 
    533       !!        !  15-08  (M. Martin) Combined surface/profile routines. 
    534497      !!---------------------------------------------------------------------- 
    535498      USE dom_oce, ONLY : gdept_n, gdept_1d   ! Ocean space and time domain variables 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r8524 r9168  
    7070      REWIND( numnam_ref )              ! Namelist namsbc_apr in reference namelist : File for atmospheric pressure forcing 
    7171      READ  ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901) 
    72 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in reference namelist', lwp ) 
     72901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_apr in reference namelist', lwp ) 
    7373 
    7474      REWIND( numnam_cfg )              ! Namelist namsbc_apr in configuration namelist : File for atmospheric pressure forcing 
    7575      READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 ) 
    76 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist', lwp ) 
     76902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist', lwp ) 
    7777      IF(lwm) WRITE ( numond, namsbc_apr ) 
    7878      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90

    r9124 r9168  
    182182      REWIND( numnam_ref )                !* Namelist namsbc_blk in reference namelist : bulk parameters 
    183183      READ  ( numnam_ref, namsbc_blk, IOSTAT = ios, ERR = 901) 
    184 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_blk in reference namelist', lwp ) 
     184901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_blk in reference namelist', lwp ) 
    185185      ! 
    186186      REWIND( numnam_cfg )                !* Namelist namsbc_blk in configuration namelist : bulk parameters 
    187187      READ  ( numnam_cfg, namsbc_blk, IOSTAT = ios, ERR = 902 ) 
    188 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_blk in configuration namelist', lwp ) 
     188902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namsbc_blk in configuration namelist', lwp ) 
    189189      ! 
    190190      IF(lwm) WRITE( numond, namsbc_blk ) 
     
    225225         ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    226226         IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    227  
    228            IF( slf_i(ifpr)%nfreqh .GT. 0._wp .AND. MOD( 3600._wp * slf_i(ifpr)%nfreqh , REAL(nn_fsbc, wp) * rdt) .NE. 0._wp  )   & 
    229             &  CALL ctl_warn( 'sbcmod time step rdt * nn_fsbc is NOT a submultiple of atmospheric forcing frequency' ) 
     227         IF( slf_i(ifpr)%nfreqh > 0. .AND. MOD( 3600. * slf_i(ifpr)%nfreqh , REAL(nn_fsbc) * rdt) /= 0. )   & 
     228            &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
     229            &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 
    230230 
    231231      END DO 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r9124 r9168  
    268268      REWIND( numnam_cfg )              ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling 
    269269      READ  ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 ) 
    270 902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp ) 
     270902   IF( ios > 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp ) 
    271271      IF(lwm) WRITE ( numond, namsbc_cpl ) 
    272272      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r6140 r9168  
    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', lwp ) 
    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', lwp ) 
    100100         IF(lwm) WRITE ( numond, namsbc_flx )  
    101101         ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r9125 r9168  
    9696         ! 
    9797      ENDIF 
    98        
    9998 
    10099      SELECT CASE ( kn_fwb ) 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r9125 r9168  
    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', lwp ) 
    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', lwp ) 
    771771         IF(lwm) WRITE ( numond, namsbc_cice ) 
    772772 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r7646 r9168  
    1717   USE sbc_oce        ! surface boundary condition: ocean fields 
    1818#if defined key_lim3 
    19    USE ice    , ONLY :   a_i  
     19   USE ice            , ONLY :   a_i 
    2020#else 
    21    USE sbc_ice, ONLY :   a_i  
     21   USE sbc_ice        , ONLY :   a_i  
    2222#endif 
     23   ! 
     24   USE in_out_manager ! I/O manager 
     25   USE iom            ! I/O manager library 
    2326   USE fldread        ! read input field 
    24    USE iom            ! I/O manager library 
    25    USE in_out_manager ! I/O manager 
    2627   USE lib_mpp        ! MPP library 
    2728   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     
    7576         REWIND( numnam_ref )              ! Namelist namsbc_iif in reference namelist : Ice if file 
    7677         READ  ( numnam_ref, namsbc_iif, IOSTAT = ios, ERR = 901) 
    77 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', lwp ) 
    7879 
    7980         REWIND( numnam_cfg )              ! Namelist Namelist namsbc_iif in configuration namelist : Ice if file 
    8081         READ  ( numnam_cfg, namsbc_iif, IOSTAT = ios, ERR = 902 ) 
    81 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', lwp ) 
    8283         IF(lwm) WRITE ( numond, namsbc_iif ) 
    8384 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r9124 r9168  
    276276      REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs  
    277277      READ  ( numnam_ref, namsbc_isf, IOSTAT = ios, ERR = 901) 
    278 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in reference namelist', lwp ) 
     278901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_isf in reference namelist', lwp ) 
    279279 
    280280      REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs 
    281281      READ  ( numnam_cfg, namsbc_isf, IOSTAT = ios, ERR = 902 ) 
    282 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist', lwp ) 
     282902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist', lwp ) 
    283283      IF(lwm) WRITE ( numond, namsbc_isf ) 
    284284 
    285       IF ( lwp ) WRITE(numout,*) 
    286       IF ( lwp ) WRITE(numout,*) 'sbc_isf_init : heat flux of the ice shelf' 
    287       IF ( lwp ) WRITE(numout,*) '~~~~~~~~~~~' 
    288       IF ( lwp ) WRITE(numout,*) '        nn_isf      = ', nn_isf 
    289       IF ( lwp ) WRITE(numout,*) '        nn_isfblk   = ', nn_isfblk 
    290       IF ( lwp ) WRITE(numout,*) '        rn_hisf_tbl = ', rn_hisf_tbl 
    291       IF ( lwp ) WRITE(numout,*) '        nn_gammablk = ', nn_gammablk  
    292       IF ( lwp ) WRITE(numout,*) '        rn_gammat0  = ', rn_gammat0   
    293       IF ( lwp ) WRITE(numout,*) '        rn_gammas0  = ', rn_gammas0   
    294       IF ( lwp ) WRITE(numout,*) '        rn_Cd0      = ', r_Cdmin_top  
     285      IF(lwp) WRITE(numout,*) 
     286      IF(lwp) WRITE(numout,*) 'sbc_isf_init : heat flux of the ice shelf' 
     287      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     288      IF(lwp) WRITE(numout,*) '   Namelist namsbc_isf :' 
     289      IF(lwp) WRITE(numout,*) '      type ice shelf melting/freezing         nn_isf      = ', nn_isf 
     290      IF(lwp) WRITE(numout,*) '      bulk formulation (nn_isf=1 only)        nn_isfblk   = ', nn_isfblk 
     291      IF(lwp) WRITE(numout,*) '      thickness of the top boundary layer     rn_hisf_tbl = ', rn_hisf_tbl 
     292      IF(lwp) WRITE(numout,*) '      gamma formulation                       nn_gammablk = ', nn_gammablk  
     293      IF(lwp) WRITE(numout,*) '      gammat coefficient                      rn_gammat0  = ', rn_gammat0   
     294      IF(lwp) WRITE(numout,*) '      gammas coefficient                      rn_gammas0  = ', rn_gammas0   
     295      IF(lwp) WRITE(numout,*) '      top drag coef. used (from namdrg_top)   rn_Cd0      = ', r_Cdmin_top  
     296 
     297 
     298                           !  1 = presence of ISF    2 = bg03 parametrisation  
     299                           !  3 = rnf file for isf   4 = ISF fwf specified 
     300                           !  option 1 and 4 need ln_isfcav = .true. (domzgr) 
    295301      ! 
    296302      ! Allocate public variable 
     
    304310      SELECT CASE ( nn_isf ) 
    305311      CASE ( 1 )  
     312         IF(lwp) WRITE(numout,*) 
     313         IF(lwp) WRITE(numout,*) '      ==>>>   presence of under iceshelf seas (nn_isf = 1)' 
    306314         rhisf_tbl(:,:) = rn_hisf_tbl 
    307315         misfkt   (:,:) = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv 
    308  
     316         ! 
    309317      CASE ( 2 , 3 ) 
    310318         IF( .NOT.l_isfcpl ) THEN 
     
    314322          ENDIF 
    315323          !  read effective lenght (BG03) 
    316           IF (nn_isf == 2) THEN 
     324          IF( nn_isf == 2 ) THEN 
     325            IF(lwp) WRITE(numout,*) 
     326            IF(lwp) WRITE(numout,*) '      ==>>>   bg03 parametrisation (nn_isf = 2)' 
    317327            CALL iom_open( sn_Leff_isf%clname, inum ) 
    318328            cvarLeff = TRIM(sn_Leff_isf%clvar) 
     
    321331            ! 
    322332            risfLeff = risfLeff*1000.0_wp           !: convertion in m 
    323           END IF 
     333         ELSE 
     334            IF(lwp) WRITE(numout,*) 
     335            IF(lwp) WRITE(numout,*) '      ==>>>   rnf file for isf (nn_isf = 3)' 
     336         ENDIF 
    324337         ! read depth of the top and bottom of the isf top boundary layer (in this case, isf front depth and grounding line depth) 
    325338         CALL iom_open( sn_depmax_isf%clname, inum ) 
     
    344357            END DO 
    345358         END DO 
    346  
     359         ! 
    347360      CASE ( 4 )  
     361         IF(lwp) WRITE(numout,*) 
     362         IF(lwp) WRITE(numout,*) '      ==>>>   specified fresh water flux in ISF (nn_isf = 4)' 
    348363         ! as in nn_isf == 1 
    349364         rhisf_tbl(:,:) = rn_hisf_tbl 
    350365         misfkt   (:,:) = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv 
    351           
     366         ! 
    352367         ! load variable used in fldread (use for temporal interpolation of isf fwf forcing) 
    353368         IF( .NOT.l_isfcpl ) THEN 
     
    356371           CALL fld_fill( sf_fwfisf, (/ sn_fwfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' ) 
    357372         ENDIF 
    358  
     373         ! 
     374      CASE DEFAULT 
     375         CALL ctl_stop( 'sbc_isf_init: wrong value of nn_isf' ) 
    359376      END SELECT 
    360377          
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r9161 r9168  
    113113      REWIND( numnam_cfg )          !* Namelist namsbc in configuration namelist : Parameters of the run 
    114114      READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 
    115 902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp ) 
     115902   IF( ios > 0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp ) 
    116116      IF(lwm) WRITE( numond, namsbc ) 
    117117      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r9161 r9168  
    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', lwp ) 
    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', lwp ) 
    274274      IF(lwm) WRITE ( numond, namsbc_rnf ) 
    275275      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r9124 r9168  
    161161      REWIND( numnam_ref )              ! Namelist namsbc_ssr in reference namelist :  
    162162      READ  ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901) 
    163 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in reference namelist', lwp ) 
     163901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_ssr in reference namelist', lwp ) 
    164164 
    165165      REWIND( numnam_cfg )              ! Namelist namsbc_ssr in configuration namelist : 
    166166      READ  ( numnam_cfg, namsbc_ssr, IOSTAT = ios, ERR = 902 ) 
    167 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist', lwp ) 
     167902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist', lwp ) 
    168168      IF(lwm) WRITE ( numond, namsbc_ssr ) 
    169169 
     
    173173         WRITE(numout,*) '~~~~~~~ ' 
    174174         WRITE(numout,*) '   Namelist namsbc_ssr :' 
    175          WRITE(numout,*) '      SST restoring term (Yes=1)             nn_sstr     = ', nn_sstr 
    176          WRITE(numout,*) '      SSS damping term (Yes=1, salt flux)    nn_sssr     = ', nn_sssr 
     175         WRITE(numout,*) '      SST restoring term (Yes=1)             nn_sstr        = ', nn_sstr 
     176         WRITE(numout,*) '         dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K' 
     177         WRITE(numout,*) '      SSS damping term (Yes=1, salt flux)    nn_sssr        = ', nn_sssr 
    177178         WRITE(numout,*) '                       (Yes=2, volume flux) ' 
    178          WRITE(numout,*) '      dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K' 
    179          WRITE(numout,*) '      dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day' 
    180          WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd 
    181          WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 
     179         WRITE(numout,*) '         dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day' 
     180         WRITE(numout,*) '         flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd 
     181         WRITE(numout,*) '         ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 
    182182      ENDIF 
    183183      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r9125 r9168  
    392392      REWIND( numnam_ref )              ! Namelist namsbc_wave in reference namelist : File for drag coeff. from wave model 
    393393      READ  ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901) 
    394 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in reference namelist', lwp ) 
     394901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_wave in reference namelist', lwp ) 
    395395          
    396396      REWIND( numnam_cfg )              ! Namelist namsbc_wave in configuration namelist : File for drag coeff. from wave model 
    397397      READ  ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 ) 
    398 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist', lwp ) 
     398902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist', lwp ) 
    399399      IF(lwm) WRITE ( numond, namsbc_wave ) 
    400400      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90

    r9023 r9168  
    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', lwp ) 
    6767      IF(lwm) WRITE ( numond, nam_tide ) 
    6868      ! 
    69       IF (ln_tide) THEN 
     69      IF( ln_tide ) THEN 
    7070         IF (lwp) THEN 
    7171            WRITE(numout,*) 
     
    7373            WRITE(numout,*) '~~~~~~~~~ ' 
    7474            WRITE(numout,*) '   Namelist nam_tide' 
    75             WRITE(numout,*) '              Use tidal components : ln_tide      = ', ln_tide 
    76             WRITE(numout,*) '      Apply astronomical potential          : ln_tide_pot  = ', ln_tide_pot 
    77             WRITE(numout,*) '      Use scalar approx. for load potential : ln_scal_load = ', ln_scal_load 
    78             WRITE(numout,*) '      Read load potential from file         : ln_read_load = ', ln_read_load 
    79             WRITE(numout,*) '      Apply ramp on tides at startup        : ln_tide_ramp = ', ln_tide_ramp 
    80             WRITE(numout,*) '      Fraction of SSH used in scal. approx. : rn_scal_load = ', rn_scal_load 
    81             WRITE(numout,*) '      Duration (days) of ramp               : rdttideramp  = ', rdttideramp 
     75            WRITE(numout,*) '      Use tidal components                      ln_tide      = ', ln_tide 
     76            WRITE(numout,*) '         Apply astronomical potential            ln_tide_pot  = ', ln_tide_pot 
     77            WRITE(numout,*) '         Use scalar approx. for load potential  ln_scal_load = ', ln_scal_load 
     78            WRITE(numout,*) '         Read load potential from file          ln_read_load = ', ln_read_load 
     79            WRITE(numout,*) '         Apply ramp on tides at startup          ln_tide_ramp = ', ln_tide_ramp 
     80            WRITE(numout,*) '         Fraction of SSH used in scal. approx.  rn_scal_load = ', rn_scal_load 
     81            WRITE(numout,*) '         Duration (days) of ramp                rdttideramp  = ', rdttideramp 
    8282         ENDIF 
    8383      ELSE 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r9094 r9168  
    12411241      REWIND( numnam_ref )              ! Namelist nameos in reference namelist : equation of state 
    12421242      READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 ) 
    1243 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist', lwp ) 
     1243901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nameos in reference namelist', lwp ) 
    12441244      ! 
    12451245      REWIND( numnam_cfg )              ! Namelist nameos in configuration namelist : equation of state 
    12461246      READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 
    1247 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp ) 
     1247902   IF( ios >  0 )  CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp ) 
    12481248      IF(lwm) WRITE( numond, nameos ) 
    12491249      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r9019 r9168  
    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', lwp ) 
    203203      IF(lwm) WRITE( numond, namtra_adv ) 
    204204      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    r9124 r9168  
    266266      REWIND( numnam_ref )              ! Namelist namtra_adv_mle in reference namelist : Tracer advection scheme 
    267267      READ  ( numnam_ref, namtra_adv_mle, IOSTAT = ios, ERR = 901) 
    268 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv_mle in reference namelist', lwp ) 
     268901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_adv_mle in reference namelist', lwp ) 
    269269 
    270270      REWIND( numnam_cfg )              ! Namelist namtra_adv_mle in configuration namelist : Tracer advection scheme 
    271271      READ  ( numnam_cfg, namtra_adv_mle, IOSTAT = ios, ERR = 902 ) 
    272 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv_mle in configuration namelist', lwp ) 
     272902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namtra_adv_mle in configuration namelist', lwp ) 
    273273      IF(lwm) WRITE ( numond, namtra_adv_mle ) 
    274274 
     
    278278         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    279279         WRITE(numout,*) '   Namelist namtra_adv_mle : mixed layer eddy advection on tracers' 
    280          WRITE(numout,*) '      use mixed layer eddy (MLE, i.e. Fox-Kemper param) (T/F)      ln_mle    = ', ln_mle 
    281          WRITE(numout,*) '      MLE type: =0 standard Fox-Kemper ; =1 new formulation        nn_mle    = ', nn_mle 
    282          WRITE(numout,*) '      magnitude of the MLE (typical value: 0.06 to 0.08)           rn_ce     = ', rn_ce 
    283          WRITE(numout,*) '      scale of ML front (ML radius of deformation) (rn_mle=0)      rn_lf     = ', rn_lf, 'm' 
    284          WRITE(numout,*) '      maximum time scale of MLE                    (rn_mle=0)      rn_time   = ', rn_time, 's' 
    285          WRITE(numout,*) '      reference latitude (degrees) of MLE coef.    (rn_mle=1)      rn_lat    = ', rn_lat, 'deg' 
    286          WRITE(numout,*) '      space interp. of MLD at u-(v-)pts (0=min,1=averaged,2=max)   nn_mld_uv = ', nn_mld_uv 
    287          WRITE(numout,*) '      =1 no MLE in case of convection ; =0 always MLE              nn_conv   = ', nn_conv 
    288          WRITE(numout,*) '      Density difference used to define ML for FK              rn_rho_c_mle  = ', rn_rho_c_mle 
     280         WRITE(numout,*) '      use mixed layer eddy (MLE, i.e. Fox-Kemper param) (T/F)      ln_mle       = ', ln_mle 
     281         WRITE(numout,*) '         MLE type: =0 standard Fox-Kemper ; =1 new formulation        nn_mle    = ', nn_mle 
     282         WRITE(numout,*) '         magnitude of the MLE (typical value: 0.06 to 0.08)           rn_ce     = ', rn_ce 
     283         WRITE(numout,*) '         scale of ML front (ML radius of deformation) (rn_mle=0)      rn_lf     = ', rn_lf, 'm' 
     284         WRITE(numout,*) '         maximum time scale of MLE                    (rn_mle=0)      rn_time   = ', rn_time, 's' 
     285         WRITE(numout,*) '         reference latitude (degrees) of MLE coef.    (rn_mle=1)      rn_lat    = ', rn_lat, 'deg' 
     286         WRITE(numout,*) '         space interp. of MLD at u-(v-)pts (0=min,1=averaged,2=max)   nn_mld_uv = ', nn_mld_uv 
     287         WRITE(numout,*) '         =1 no MLE in case of convection ; =0 always MLE              nn_conv   = ', nn_conv 
     288         WRITE(numout,*) '         Density difference used to define ML for FK              rn_rho_c_mle  = ', rn_rho_c_mle 
    289289      ENDIF 
    290290      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r9019 r9168  
    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', lwp ) 
    142142      IF(lwm) WRITE ( numond, nambbc ) 
    143143      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r9124 r9168  
    127127         CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef 
    128128         ! 
    129       END IF 
     129      ENDIF 
    130130      ! 
    131131      IF( nn_bbl_adv /= 0 ) THEN                    !* Advective bbl 
     
    140140         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport 
    141141         ! 
    142       END IF 
     142      ENDIF 
    143143 
    144144      IF( l_trdtra )   THEN                      ! send the trends for further diagnostics 
     
    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', lwp ) 
    492492      IF(lwm) WRITE ( numond, nambbl ) 
    493493      ! 
     
    528528      mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ;  mbkv_d(:,:) = MAX( INT( zmbkv(:,:) ), 1 ) 
    529529      ! 
    530                                         !* sign of grad(H) at u- and v-points; zero if grad(H) = 0 
     530      !                             !* sign of grad(H) at u- and v-points; zero if grad(H) = 0 
    531531      mgrhu(:,:) = 0   ;   mgrhv(:,:) = 0 
    532532      DO jj = 1, jpjm1 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r9019 r9168  
    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', lwp ) 
    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', lwp ) 
    186186      IF(lwm) WRITE ( numond, namtra_dmp ) 
    187187      ! 
     
    191191         WRITE(numout,*) '~~~~~~~~~~~~' 
    192192         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters' 
    193          WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp 
    194          WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp 
    195          WRITE(numout,*) '      Damping file name               cn_resto = ', cn_resto 
     193         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp   = ', ln_tradmp 
     194         WRITE(numout,*) '         mixed layer damping option      nn_zdmp  = ', nn_zdmp 
     195         WRITE(numout,*) '         Damping file name               cn_resto = ', cn_resto 
    196196         WRITE(numout,*) 
    197197      ENDIF 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r9124 r9168  
    340340      REWIND( numnam_cfg )              ! Namelist namtra_qsr in configuration namelist 
    341341      READ  ( numnam_cfg, namtra_qsr, IOSTAT = ios, ERR = 902 ) 
    342 902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp ) 
     342902   IF( ios > 0 )   CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp ) 
    343343      IF(lwm) WRITE ( numond, namtra_qsr ) 
    344344      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90

    r7646 r9168  
    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', lwp ) 
    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', lwp ) 
    5555      IF(lwm) WRITE( numond, namtrd ) 
    5656      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90

    r9125 r9168  
    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', lwp ) 
    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', lwp ) 
    741741      IF(lwm) WRITE( numond, namtrd_mxl ) 
    742742      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfdrg.F90

    r9089 r9168  
    162162      REWIND( numnam_cfg )                   ! Namelist namdrg in configuration namelist 
    163163      READ  ( numnam_cfg, namdrg, IOSTAT = ios, ERR = 902 ) 
    164 902   IF( ios /= 0 )   CALL ctl_nam( ios , 'namdrg in configuration namelist', lwp ) 
     164902   IF( ios > 0 )   CALL ctl_nam( ios , 'namdrg in configuration namelist', lwp ) 
    165165      IF(lwm) WRITE ( numond, namdrg ) 
    166166      ! 
     
    263263      IF(ll_top)   READ  ( numnam_cfg, namdrg_top, IOSTAT = ios, ERR = 902 ) 
    264264      IF(ll_bot)   READ  ( numnam_cfg, namdrg_bot, IOSTAT = ios, ERR = 902 ) 
    265 902   IF( ios /= 0 )   CALL ctl_nam( ios , TRIM(cl_namcfg), lwp ) 
     265902   IF( ios > 0 )   CALL ctl_nam( ios , TRIM(cl_namcfg), lwp ) 
    266266      IF(lwm .AND. ll_top)   WRITE ( numond, namdrg_top ) 
    267267      IF(lwm .AND. ll_bot)   WRITE ( numond, namdrg_bot ) 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/module_example

    r9019 r9168  
    153153      READ  ( numnam_ref, namexa, IOSTAT = ios, ERR = 901) 
    154154901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in reference namelist', lwp ) 
    155  
     155      ! 
    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', lwp ) 
    159159   ! Output namelist for control 
    160160      WRITE ( numond, namexa ) 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r9161 r9168  
    257257      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints 
    258258      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    259 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    260       ! 
     259901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    261260      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    262261      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    263 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
     262902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    264263      ! 
    265264      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints 
    266265      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    267 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    268  
     266903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    269267      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark 
    270268      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    271 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
     269904   IF( ios >  0 )  CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    272270 
    273271      !                             !--------------------------! 
Note: See TracChangeset for help on using the changeset viewer.