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 9169 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90 – NEMO

Ignore:
Timestamp:
2017-12-26T17:32:56+01:00 (6 years ago)
Author:
gm
Message:

dev_merge_2017: all SRC: finalize the removal of useless warning when reading namelist_cfg + remove all nn_closea + nn_msh replaced by a logical

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r9168 r9169  
    241241      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrnfcl     
    242242      REAL(wp), DIMENSION(:,:  ), ALLOCATABLE :: zrnf 
    243       ! 
     243      !! 
    244244      NAMELIST/namsbc_rnf/ cn_dir            , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   & 
    245245         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   & 
     
    292292         ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow) 
    293293         IF(lwp) WRITE(numout,*) 
    294          IF(lwp) WRITE(numout,*) '          runoffs inflow read in a file' 
     294         IF(lwp) WRITE(numout,*) '   ==>>>   runoffs inflow read in a file' 
    295295         IF( ierror > 0 ) THEN 
    296296            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_rnf structure' )   ;   RETURN 
     
    303303      IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure 
    304304         IF(lwp) WRITE(numout,*) 
    305          IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file' 
     305         IF(lwp) WRITE(numout,*) '   ==>>>   runoffs temperatures read in a file' 
    306306         ALLOCATE( sf_t_rnf(1), STAT=ierror  ) 
    307307         IF( ierror > 0 ) THEN 
     
    315315      IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures 
    316316         IF(lwp) WRITE(numout,*) 
    317          IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file' 
     317         IF(lwp) WRITE(numout,*) '   ==>>>   runoffs salinities read in a file' 
    318318         ALLOCATE( sf_s_rnf(1), STAT=ierror  ) 
    319319         IF( ierror > 0 ) THEN 
     
    327327      IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file 
    328328         IF(lwp) WRITE(numout,*) 
    329          IF(lwp) WRITE(numout,*) '          runoffs depth read in a file' 
     329         IF(lwp) WRITE(numout,*) '   ==>>>   runoffs depth read in a file' 
    330330         rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 
    331331         IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year  
     
    364364         ! 
    365365         IF(lwp) WRITE(numout,*) 
    366          IF(lwp) WRITE(numout,*) '    depth of runoff computed once from max value of runoff' 
    367          IF(lwp) WRITE(numout,*) '    max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max 
    368          IF(lwp) WRITE(numout,*) '    depth over which runoffs is spread                        rn_dep_max = ', rn_dep_max 
    369          IF(lwp) WRITE(numout,*) '     create (=1) a runoff depth file or not (=0)      nn_rnf_depth_file  = ', nn_rnf_depth_file 
     366         IF(lwp) WRITE(numout,*) '   ==>>>  depth of runoff computed once from max value of runoff' 
     367         IF(lwp) WRITE(numout,*) '        max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max 
     368         IF(lwp) WRITE(numout,*) '        depth over which runoffs is spread                        rn_dep_max = ', rn_dep_max 
     369         IF(lwp) WRITE(numout,*) '        create (=1) a runoff depth file or not (=0)      nn_rnf_depth_file  = ', nn_rnf_depth_file 
    370370 
    371371         CALL iom_open( TRIM( sn_rnf%clname ), inum )    !  open runoff file 
     
    420420         ! 
    421421         IF( nn_rnf_depth_file == 1 ) THEN      !  save  output nb levels for runoff 
    422             IF(lwp) WRITE(numout,*) '              create runoff depht file' 
     422            IF(lwp) WRITE(numout,*) '   ==>>>   create runoff depht file' 
    423423            CALL iom_open  ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
    424424            CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf ) 
     
    453453         ENDIF 
    454454         IF(lwp) WRITE(numout,*) 
    455          IF(lwp) WRITE(numout,*) '          Specific treatment used in vicinity of river mouths :' 
     455         IF(lwp) WRITE(numout,*) '   ==>>>   Specific treatment used in vicinity of river mouths :' 
    456456         IF(lwp) WRITE(numout,*) '             - Increase Kz in surface layers (if rn_hrnf > 0 )' 
    457457         IF(lwp) WRITE(numout,*) '               by ', rn_avt_rnf,' m2/s  over ', nkrnf, ' w-levels' 
     
    463463      ELSE                                      ! No treatment at river mouths 
    464464         IF(lwp) WRITE(numout,*) 
    465          IF(lwp) WRITE(numout,*) '          No specific treatment at river mouths' 
     465         IF(lwp) WRITE(numout,*) '   ==>>>   No specific treatment at river mouths' 
    466466         rnfmsk  (:,:) = 0._wp 
    467467         rnfmsk_z(:)   = 0._wp 
Note: See TracChangeset for help on using the changeset viewer.