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 9190 – NEMO

Changeset 9190


Ignore:
Timestamp:
2018-01-06T15:18:23+01:00 (6 years ago)
Author:
gm
Message:

dev_merge_2017: OPA_SRC: style only, results unchanged

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

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r9169 r9190  
    284284      IF(lwp) THEN 
    285285         WRITE(numout,*) 
    286          WRITE(numout,*) 'dom_nam  : domain initialization through namelist read' 
     286         WRITE(numout,*) 'dom_nam : domain initialization through namelist read' 
    287287         WRITE(numout,*) '~~~~~~~ ' 
    288288      ENDIF 
     
    297297      ! 
    298298      IF(lwp) THEN                  ! control print 
    299          WRITE(numout,*) '   Namelist : namrun' 
     299         WRITE(numout,*) '   Namelist : namrun   ---   run parameters' 
    300300         WRITE(numout,*) '      job number                      nn_no           = ', nn_no 
    301301         WRITE(numout,*) '      experiment name for output      cn_exp          = ', TRIM( cn_exp           ) 
     
    359359      IF( Agrif_Root() ) THEN 
    360360#endif 
     361      IF(lwp) WRITE(numout,*) 
    361362      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    362363      CASE (  1 )  
    363364         CALL ioconf_calendar('gregorian') 
    364          IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year' 
     365         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year' 
    365366      CASE (  0 ) 
    366367         CALL ioconf_calendar('noleap') 
    367          IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year' 
     368         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year' 
    368369      CASE ( 30 ) 
    369370         CALL ioconf_calendar('360d') 
    370          IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
     371         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
    371372      END SELECT 
    372373#if defined key_agrif 
     
    512513         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = INT( zorca_res ) 
    513514         ! 
    514          WRITE(ldtxt(ii),*) '       '                                                     ;   ii = ii+1 
    515          WRITE(ldtxt(ii),*) '       ==>>>   ORCA configuration '                          ;   ii = ii+1 
    516          WRITE(ldtxt(ii),*) '       '                                                     ;   ii = ii+1 
     515         WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1 
     516         WRITE(ldtxt(ii),*) '   ==>>>   ORCA configuration '                           ;   ii = ii+1 
     517         WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1 
    517518         ! 
    518519      ELSE                                !- cd_cfg & k_cfg are not used 
     
    524525            CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found 
    525526            CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found 
    526             IF( TRIM(cd_cfg) .EQ. '!') cd_cfg = 'UNKNOWN' 
    527             IF( kk_cfg .EQ. -999     ) kk_cfg = -9999999 
     527            IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN' 
     528            IF( kk_cfg == -999     ) kk_cfg = -9999999 
    528529         ENDIF 
    529530         ! 
     
    536537      CALL iom_close( inum ) 
    537538      ! 
    538       WRITE(ldtxt(ii),*) '   cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1 
    539       WRITE(ldtxt(ii),*) '   jpiglo = ', kpi                                              ;   ii = ii+1 
    540       WRITE(ldtxt(ii),*) '   jpjglo = ', kpj                                              ;   ii = ii+1 
    541       WRITE(ldtxt(ii),*) '   jpkglo = ', kpk                                              ;   ii = ii+1 
    542       WRITE(ldtxt(ii),*) '   type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1 
     539      WRITE(ldtxt(ii),*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1 
     540      WRITE(ldtxt(ii),*) '      jpiglo = ', kpi                                              ;   ii = ii+1 
     541      WRITE(ldtxt(ii),*) '      jpjglo = ', kpj                                              ;   ii = ii+1 
     542      WRITE(ldtxt(ii),*) '      jpkglo = ', kpk                                              ;   ii = ii+1 
     543      WRITE(ldtxt(ii),*) '      type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1 
    543544      !         
    544545   END SUBROUTINE domain_cfg 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r9169 r9190  
    183183      IF(lwp) THEN 
    184184         WRITE(numout,*) 
    185          WRITE(numout,*) 'hgr_read : read the horizontal coordinates in mesh_mask' 
    186          WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk 
     185         WRITE(numout,*) '   hgr_read : read the horizontal coordinates in mesh_mask' 
     186         WRITE(numout,*) '   ~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk 
    187187      ENDIF 
    188188      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r9168 r9190  
    10171017      ! 
    10181018#if defined key_agrif 
    1019       IF( (.NOT.Agrif_Root()).AND.(.NOT.ln_vvl_zstar) )CALL ctl_stop( 'AGRIF is implemented with zstar coordinate only' ) 
     1019      IF( (.NOT.Agrif_Root()).AND.(.NOT.ln_vvl_zstar) )   CALL ctl_stop( 'AGRIF is implemented with zstar coordinate only' ) 
    10201020#endif 
    10211021      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90

    r9168 r9190  
    131131         WRITE(numout,*) 
    132132         SELECT CASE( n_dynadv ) 
    133          CASE( np_LIN_dyn )   ;   WRITE(numout,*) '      ===>>   linear dynamics : no momentum advection used' 
    134          CASE( np_VEC_c2  )   ;   WRITE(numout,*) '      ===>>   vector form : keg + zad + vor is used'  
     133         CASE( np_LIN_dyn )   ;   WRITE(numout,*) '   ==>>>   linear dynamics : no momentum advection used' 
     134         CASE( np_VEC_c2  )   ;   WRITE(numout,*) '   ==>>>   vector form : keg + zad + vor is used'  
    135135            IF( nn_dynkeg == nkeg_C2  )   WRITE(numout,*) '              with Centered standard keg scheme' 
    136136            IF( nn_dynkeg == nkeg_HW  )   WRITE(numout,*) '              with Hollingsworth keg scheme' 
    137          CASE( np_FLX_c2  )   ;   WRITE(numout,*) '      ===>>   flux form   : 2nd order scheme is used' 
    138          CASE( np_FLX_ubs )   ;   WRITE(numout,*) '      ===>>   flux form   : UBS       scheme is used' 
     137         CASE( np_FLX_c2  )   ;   WRITE(numout,*) '   ==>>>   flux form   : 2nd order scheme is used' 
     138         CASE( np_FLX_ubs )   ;   WRITE(numout,*) '   ==>>>   flux form   : UBS       scheme is used' 
    139139         END SELECT 
    140140      ENDIF 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r9019 r9190  
    181181      IF(lwp) THEN 
    182182         WRITE(numout,*) 
    183          IF( nldf == np_no_ldf )   WRITE(numout,*) '      ===>>   NO lateral viscosity' 
    184          IF( nldf == np_lap    )   WRITE(numout,*) '      ===>>   iso-level laplacian operator' 
    185          IF( nldf == np_lap_i  )   WRITE(numout,*) '      ===>>   rotated laplacian operator with iso-level background' 
    186          IF( nldf == np_blp    )   WRITE(numout,*) '      ===>>   iso-level bi-laplacian operator' 
     183         IF( nldf == np_no_ldf )   WRITE(numout,*) '   ==>>>   NO lateral viscosity' 
     184         IF( nldf == np_lap    )   WRITE(numout,*) '   ==>>>   iso-level laplacian operator' 
     185         IF( nldf == np_lap_i  )   WRITE(numout,*) '   ==>>>   rotated laplacian operator with iso-level background' 
     186         IF( nldf == np_blp    )   WRITE(numout,*) '   ==>>>   iso-level bi-laplacian operator' 
    187187      ENDIF 
    188188      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r9169 r9190  
    226226      IF(lwp) THEN 
    227227         WRITE(numout,*) 
    228          IF( nspg == np_EXP )   WRITE(numout,*) '      ===>>   explicit free surface' 
    229          IF( nspg == np_TS  )   WRITE(numout,*) '      ===>>   free surface with time splitting scheme' 
    230          IF( nspg == np_NO  )   WRITE(numout,*) '      ===>>   No surface surface pressure gradient trend in momentum Eqs.' 
     228         IF( nspg == np_EXP )   WRITE(numout,*) '   ==>>>   explicit free surface' 
     229         IF( nspg == np_TS  )   WRITE(numout,*) '   ==>>>   free surface with time splitting scheme' 
     230         IF( nspg == np_NO  )   WRITE(numout,*) '   ==>>>   No surface surface pressure gradient trend in momentum Eqs.' 
    231231      ENDIF 
    232232      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r9168 r9190  
    611611      SELECT CASE( n_dynadv ) 
    612612      CASE( np_LIN_dyn ) 
    613          IF(lwp) WRITE(numout,*) '      ===>>   linear dynamics : total vorticity = Coriolis' 
     613         IF(lwp) WRITE(numout,*) '   ==>>>   linear dynamics : total vorticity = Coriolis' 
    614614         nrvm = np_COR        ! planetary vorticity 
    615615         ntot = np_COR        !     -         - 
    616616      CASE( np_VEC_c2  ) 
    617          IF(lwp) WRITE(numout,*) '      ===>>   vector form dynamics : total vorticity = Coriolis + relative vorticity'  
     617         IF(lwp) WRITE(numout,*) '   ==>>>   vector form dynamics : total vorticity = Coriolis + relative vorticity'  
    618618         nrvm = np_RVO        ! relative vorticity 
    619619         ntot = np_CRV        ! relative + planetary vorticity          
    620620      CASE( np_FLX_c2 , np_FLX_ubs  ) 
    621          IF(lwp) WRITE(numout,*) '      ===>>   flux form dynamics : total vorticity = Coriolis + metric term' 
     621         IF(lwp) WRITE(numout,*) '   ==>>>   flux form dynamics : total vorticity = Coriolis + metric term' 
    622622         nrvm = np_MET        ! metric term 
    623623         ntot = np_CME        ! Coriolis + metric term 
     
    627627         WRITE(numout,*) 
    628628         SELECT CASE( nvor_scheme ) 
    629          CASE( np_ENE )   ;   WRITE(numout,*) '      ===>>   energy conserving scheme' 
    630          CASE( np_ENS )   ;   WRITE(numout,*) '      ===>>   enstrophy conserving scheme' 
    631          CASE( np_MIX )   ;   WRITE(numout,*) '      ===>>   mixed enstrophy/energy conserving scheme' 
    632          CASE( np_EEN )   ;   WRITE(numout,*) '      ===>>   energy and enstrophy conserving scheme' 
     629         CASE( np_ENE )   ;   WRITE(numout,*) '   ==>>>   energy conserving scheme' 
     630         CASE( np_ENS )   ;   WRITE(numout,*) '   ==>>>   enstrophy conserving scheme' 
     631         CASE( np_MIX )   ;   WRITE(numout,*) '   ==>>>   mixed enstrophy/energy conserving scheme' 
     632         CASE( np_EEN )   ;   WRITE(numout,*) '   ==>>>   energy and enstrophy conserving scheme' 
    633633         END SELECT          
    634634      ENDIF 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90

    r9019 r9190  
    11MODULE icb_oce 
    2  
    32   !!====================================================================== 
    43   !!                       ***  MODULE  icb_oce  *** 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90

    r5215 r9190  
    11MODULE icbclv 
    2  
    32   !!====================================================================== 
    43   !!                       ***  MODULE  icbclv  *** 
     
    1110   !!            -    !  2011-05  (Alderson)       budgets into separate module 
    1211   !!---------------------------------------------------------------------- 
     12 
    1313   !!---------------------------------------------------------------------- 
    1414   !!   icb_clv_flx   : transfer input flux of ice into iceberg classes 
     
    4545      !! 
    4646      !!---------------------------------------------------------------------- 
    47       INTEGER, INTENT(in)             :: kt 
     47      INTEGER, INTENT(in) ::  kt 
    4848      ! 
    49       REAL(wp)                        :: zcalving_used, zdist, zfact 
    50       INTEGER                         :: jn, ji, jj                    ! loop counters 
    51       INTEGER                         :: imx                           ! temporary integer for max berg class 
    52       LOGICAL, SAVE                   :: ll_first_call = .TRUE. 
     49      REAL(wp)      ::  zcalving_used, zdist, zfact 
     50      INTEGER       ::  jn, ji, jj                    ! loop counters 
     51      INTEGER       ::  imx                           ! temporary integer for max berg class 
     52      LOGICAL, SAVE ::  ll_first_call = .TRUE. 
    5353      !!---------------------------------------------------------------------- 
    5454      ! 
     
    7070         DO jj = 2, jpjm1 
    7171            DO ji = 2, jpim1 
    72                IF( berg_grid%calving(ji,jj) /= 0._wp )                                  &    ! Need units of J 
    73                   berg_grid%stored_heat(ji,jj) = SUM( berg_grid%stored_ice(ji,jj,:) ) *         &  ! initial stored ice in kg 
    74                                          berg_grid%calving_hflx(ji,jj) * e1e2t(ji,jj) /   &  ! J/s/m2 x m^2 = J/s 
    75                                          berg_grid%calving(ji,jj)                            ! /calving in kg/s 
     72               IF( berg_grid%calving(ji,jj) /= 0._wp )                                          &    ! Need units of J 
     73                  berg_grid%stored_heat(ji,jj) = SUM( berg_grid%stored_ice(ji,jj,:) ) *         &    ! initial stored ice in kg 
     74                     &                   berg_grid%calving_hflx(ji,jj) * e1e2t(ji,jj) / berg_grid%calving(ji,jj)   ! J/s/m2 x m^2  
     75                     !                                                                                             ! = J/s/calving in kg/s 
    7676            END DO 
    7777         END DO 
     
    8080      ! assume that all calving flux must be distributed even if distribution array does not sum 
    8181      ! to one - this may not be what is intended, but it's what you've got 
    82       DO jj = 1,jpj 
    83          DO ji = 1,jpi 
     82      DO jj = 1, jpj 
     83         DO ji = 1, jpi 
    8484            imx = berg_grid%maxclass(ji,jj) 
    8585            zdist = SUM( rn_distribution(1:nclasses) ) / SUM( rn_distribution(1:imx) ) 
    8686            DO jn = 1, imx 
    87                berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn) + & 
    88                                           berg_dt * berg_grid%calving(ji,jj) * rn_distribution(jn) * zdist 
     87               berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn)     & 
     88                  &                           + berg_dt * berg_grid%calving(ji,jj) * rn_distribution(jn) * zdist 
    8989            END DO 
    9090         END DO 
     
    9898      ! 
    9999   END SUBROUTINE icb_clv_flx 
     100 
    100101 
    101102   SUBROUTINE icb_clv() 
     
    171172      END DO 
    172173      ! 
    173       DO jn = 1,nclasses 
     174      DO jn = 1, nclasses 
    174175         CALL lbc_lnk( berg_grid%stored_ice(:,:,jn), 'T', 1._wp ) 
    175176      END DO 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90

    r5836 r9190  
    11MODULE icbdia 
    2  
    32   !!====================================================================== 
    43   !!                       ***  MODULE  icbdia  *** 
     
    1312   !!            -  !                            from the right points in the code 
    1413   !!---------------------------------------------------------------------- 
     14  
    1515   !!---------------------------------------------------------------------- 
    16    !! icb_dia_init : initialise iceberg budgeting 
     16   !!   icb_dia_init  : initialise iceberg budgeting 
     17   !!   icb_dia       : global iceberg diagnostics 
     18   !!   icb_dia_step  : reset at the beginning of each timestep 
     19   !!   icb_dia_put   : output (via iom_put) iceberg fields 
     20   !!   icb_dia_calve :  
     21   !!   icb_dia_income:  
     22   !!   icb_dia_size  :  
     23   !!   icb_dia_speed :  
     24   !!   icb_dia_melt  :  
     25   !!   report_state  :  
     26   !!   report_consistant :  
     27   !!   report_budget :  
     28   !!   report_istate :  
     29   !!   report_ibudget:  
    1730   !!---------------------------------------------------------------------- 
    1831   USE par_oce        ! ocean parameters 
     
    8598      !!---------------------------------------------------------------------- 
    8699      ! 
    87       IF( .NOT. ln_bergdia ) RETURN 
     100      IF( .NOT.ln_bergdia )  RETURN 
    88101 
    89102      ALLOCATE( berg_melt    (jpi,jpj)   )           ;   berg_melt   (:,:)   = 0._wp 
     
    136149 
    137150      floating_mass_start       = icb_utl_mass( first_berg ) 
    138       bergs_mass_start          = icb_utl_mass( first_berg, justbergs=.true. ) 
    139       bits_mass_start           = icb_utl_mass( first_berg, justbits=.true. ) 
     151      bergs_mass_start          = icb_utl_mass( first_berg, justbergs=.TRUE. ) 
     152      bits_mass_start           = icb_utl_mass( first_berg, justbits =.TRUE. ) 
    140153      IF( lk_mpp ) THEN 
    141154         ALLOCATE( rsumbuf(23) )          ; rsumbuf(:) = 0._wp 
     
    159172      !! for this we pack variables into buffer so we only need one mpp_sum 
    160173      !!---------------------------------------------------------------------- 
    161       LOGICAL, INTENT(in) ::   ld_budge 
    162       ! 
    163       INTEGER             ::   ik 
    164       REAL(wp)            ::   zunused_calving, ztmpsum, zgrdd_berg_mass, zgrdd_bits_mass 
    165       !!---------------------------------------------------------------------- 
    166       ! 
    167       IF( .NOT. ln_bergdia )   RETURN 
     174      LOGICAL, INTENT(in) ::   ld_budge   ! 
     175      ! 
     176      INTEGER ::   ik 
     177      REAL(wp)::   zunused_calving, ztmpsum, zgrdd_berg_mass, zgrdd_bits_mass 
     178      !!---------------------------------------------------------------------- 
     179      ! 
     180      IF( .NOT.ln_bergdia )   RETURN 
    168181 
    169182      zunused_calving      = SUM( berg_grid%calving(:,:) ) 
     
    181194      ztmpsum              = SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:) ) 
    182195      calving_out_heat_net = calving_out_heat_net + ztmpsum * berg_dt   ! Units of J 
    183  
     196      ! 
    184197      IF( ld_budge ) THEN 
    185198         stored_end        = SUM( berg_grid%stored_ice(:,:,:) ) 
    186199         stored_heat_end   = SUM( berg_grid%stored_heat(:,:) ) 
    187200         floating_mass_end = icb_utl_mass( first_berg ) 
    188          bergs_mass_end    = icb_utl_mass( first_berg,justbergs=.true. ) 
    189          bits_mass_end     = icb_utl_mass( first_berg,justbits=.true. ) 
     201         bergs_mass_end    = icb_utl_mass( first_berg,justbergs=.TRUE. ) 
     202         bits_mass_end     = icb_utl_mass( first_berg,justbits =.TRUE. ) 
    190203         floating_heat_end = icb_utl_heat( first_berg ) 
    191  
     204         ! 
    192205         nbergs_end        = icb_utl_count() 
    193206         zgrdd_berg_mass   = SUM( berg_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) ) 
    194207         zgrdd_bits_mass   = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) ) 
    195  
     208         ! 
    196209         IF( lk_mpp ) THEN 
    197210            rsumbuf( 1) = stored_end 
     
    218231            rsumbuf(22) = zgrdd_berg_mass 
    219232            rsumbuf(23) = zgrdd_bits_mass 
    220  
     233            ! 
    221234            CALL mpp_sum( rsumbuf(1:23), 23) 
    222  
     235            ! 
    223236            stored_end                = rsumbuf( 1) 
    224237            stored_heat_end           = rsumbuf( 2) 
     
    244257            zgrdd_berg_mass           = rsumbuf(22) 
    245258            zgrdd_bits_mass           = rsumbuf(23) 
    246  
     259            ! 
    247260            nsumbuf(1) = nbergs_end 
    248261            nsumbuf(2) = nbergs_calved 
     
    252265               nsumbuf(4+ik) = nbergs_calved_by_class(ik) 
    253266            END DO 
    254  
    255267            CALL mpp_sum( nsumbuf(1:nclasses+4), nclasses+4 ) 
    256  
     268            ! 
    257269            nbergs_end        = nsumbuf(1) 
    258270            nbergs_calved     = nsumbuf(2) 
     
    261273            DO ik = 1,nclasses 
    262274               nbergs_calved_by_class(ik)= nsumbuf(4+ik) 
    263             ENDDO 
    264  
     275            END DO 
     276            ! 
    265277         ENDIF 
    266  
    267          CALL report_state( 'stored ice','kg','',stored_start,'',stored_end,'') 
    268          CALL report_state( 'floating','kg','',floating_mass_start,'',floating_mass_end,'',nbergs_end) 
    269          CALL report_state( 'icebergs','kg','',bergs_mass_start,'',bergs_mass_end,'') 
    270          CALL report_state( 'bits','kg','',bits_mass_start,'',bits_mass_end,'') 
    271          CALL report_istate( 'berg #','',nbergs_start,'',nbergs_end,'') 
     278         ! 
     279         CALL report_state  ( 'stored ice','kg','',stored_start,'',stored_end,'') 
     280         CALL report_state  ( 'floating','kg','',floating_mass_start,'',floating_mass_end,'',nbergs_end ) 
     281         CALL report_state  ( 'icebergs','kg','',bergs_mass_start,'',bergs_mass_end,'') 
     282         CALL report_state  ( 'bits','kg','',bits_mass_start,'',bits_mass_end,'') 
     283         CALL report_istate ( 'berg #','',nbergs_start,'',nbergs_end,'') 
    272284         CALL report_ibudget( 'berg #','calved',nbergs_calved, & 
    273                                        'melted',nbergs_melted, & 
    274                                        '#',nbergs_start,nbergs_end) 
     285            &                          'melted',nbergs_melted, & 
     286            &                          '#',nbergs_start,nbergs_end) 
    275287         CALL report_budget( 'stored mass','kg','calving used',calving_used_net, & 
    276                                            'bergs',calving_to_bergs_net, & 
    277                                            'stored mass',stored_start,stored_end) 
     288            &                              'bergs',calving_to_bergs_net, & 
     289            &                              'stored mass',stored_start,stored_end) 
    278290         CALL report_budget( 'floating mass','kg','calving used',calving_to_bergs_net, & 
    279                                              'bergs',melt_net, & 
    280                                              'stored mass',floating_mass_start,floating_mass_end) 
     291            &                                'bergs',melt_net, & 
     292            &                                'stored mass',floating_mass_start,floating_mass_end) 
    281293         CALL report_budget( 'berg mass','kg','calving',calving_to_bergs_net, & 
    282                                               'melt+eros',berg_melt_net, & 
    283                                               'berg mass',bergs_mass_start,bergs_mass_end) 
     294            &                                 'melt+eros',berg_melt_net, & 
     295            &                                 'berg mass',bergs_mass_start,bergs_mass_end) 
    284296         CALL report_budget( 'bits mass','kg','eros used',bits_src_net, & 
    285                                               'bergs',bits_melt_net, & 
    286                                               'stored mass',bits_mass_start,bits_mass_end) 
     297            &                                 'bergs',bits_melt_net, & 
     298            &                                 'stored mass',bits_mass_start,bits_mass_end) 
    287299         CALL report_budget( 'net mass','kg','recvd',calving_rcv_net, & 
    288                                              'rtrnd',calving_ret_net, & 
    289                                              'net mass',stored_start+floating_mass_start, & 
    290                                                         stored_end+floating_mass_end) 
     300            &                                'rtrnd',calving_ret_net, & 
     301            &                                'net mass',stored_start+floating_mass_start, & 
     302            &                                           stored_end+floating_mass_end) 
    291303         CALL report_consistant( 'iceberg mass','kg','gridded',zgrdd_berg_mass,'bergs',bergs_mass_end) 
    292304         CALL report_consistant( 'bits mass','kg','gridded',zgrdd_bits_mass,'bits',bits_mass_end) 
    293305         CALL report_state( 'net heat','J','',stored_heat_start+floating_heat_start,'', & 
    294                                               stored_heat_end+floating_heat_end,'') 
     306            &                                 stored_heat_end+floating_heat_end,'') 
    295307         CALL report_state( 'stored heat','J','',stored_heat_start,'',stored_heat_end,'') 
    296308         CALL report_state( 'floating heat','J','',floating_heat_start,'',floating_heat_end,'') 
    297309         CALL report_budget( 'net heat','J','net heat',calving_src_heat_net, & 
    298                                             'net heat',calving_out_heat_net, & 
    299                                             'net heat',stored_heat_start+floating_heat_start, & 
    300                                                        stored_heat_end+floating_heat_end) 
     310            &                               'net heat',calving_out_heat_net, & 
     311            &                               'net heat',stored_heat_start+floating_heat_start, & 
     312            &                                          stored_heat_end+floating_heat_end) 
    301313         CALL report_budget( 'stored heat','J','calving used',calving_src_heat_used_net, & 
    302                                                'bergs',heat_to_bergs_net, & 
    303                                                'net heat',stored_heat_start,stored_heat_end) 
     314            &                                  'bergs',heat_to_bergs_net, & 
     315            &                                  'net heat',stored_heat_start,stored_heat_end) 
    304316         CALL report_budget( 'flting heat','J','calved',heat_to_bergs_net, & 
    305                                                'melt',heat_to_ocean_net, & 
    306                                                'net heat',floating_heat_start,floating_heat_end) 
     317            &                                  'melt',heat_to_ocean_net, & 
     318            &                                  'net heat',floating_heat_start,floating_heat_end) 
    307319         IF (nn_verbose_level >= 1) THEN 
    308320            CALL report_consistant( 'top interface','kg','from SIS',calving_src_net, & 
    309                                     'received',calving_rcv_net) 
     321               &                    'received',calving_rcv_net) 
    310322            CALL report_consistant( 'bot interface','kg','sent',calving_out_net, & 
    311                                     'returned',calving_ret_net) 
     323               &                    'returned',calving_ret_net) 
    312324         ENDIF 
    313325         WRITE( numicb, '("calved by class = ",i6,20(",",i6))') (nbergs_calved_by_class(ik),ik=1,nclasses) 
    314          IF ( nspeeding_tickets > 0 ) WRITE( numicb, '("speeding tickets issued = ",i6)') nspeeding_tickets 
    315  
     326         IF( nspeeding_tickets > 0 )  WRITE( numicb, '("speeding tickets issued = ",i6)') nspeeding_tickets 
     327         ! 
    316328         nbergs_start              = nbergs_end 
    317329         stored_start              = stored_end 
     
    350362      !!---------------------------------------------------------------------- 
    351363      ! 
    352       IF( .NOT. ln_bergdia ) RETURN 
    353       berg_melt    (:,:)   = 0._wp 
    354       buoy_melt    (:,:)   = 0._wp 
    355       eros_melt    (:,:)   = 0._wp 
    356       conv_melt    (:,:)   = 0._wp 
    357       bits_src     (:,:)   = 0._wp 
    358       bits_melt    (:,:)   = 0._wp 
    359       bits_mass    (:,:)   = 0._wp 
    360       berg_mass    (:,:)   = 0._wp 
    361       virtual_area (:,:)   = 0._wp 
    362       real_calving (:,:,:) = 0._wp 
     364      IF( .NOT.ln_bergdia )  RETURN 
     365      berg_melt   (:,:)   = 0._wp 
     366      buoy_melt   (:,:)   = 0._wp 
     367      eros_melt   (:,:)   = 0._wp 
     368      conv_melt   (:,:)   = 0._wp 
     369      bits_src    (:,:)   = 0._wp 
     370      bits_melt   (:,:)   = 0._wp 
     371      bits_mass   (:,:)   = 0._wp 
     372      berg_mass   (:,:)   = 0._wp 
     373      virtual_area(:,:)   = 0._wp 
     374      real_calving(:,:,:) = 0._wp 
    363375      ! 
    364376   END SUBROUTINE icb_dia_step 
     
    369381      !!---------------------------------------------------------------------- 
    370382      ! 
    371       IF( .NOT. ln_bergdia )   RETURN            !!gm useless iom will control whether it is output or not 
     383      IF( .NOT.ln_bergdia )   RETURN            !!gm useless iom will control whether it is output or not 
    372384      ! 
    373385      CALL iom_put( "berg_melt"        , berg_melt   (:,:)   )   ! Melt rate of icebergs                     [kg/m2/s] 
     
    388400      !!---------------------------------------------------------------------- 
    389401      !!---------------------------------------------------------------------- 
    390       INTEGER, INTENT(in)  ::   ki, kj, kn 
     402      INTEGER , INTENT(in)  ::   ki, kj, kn 
    391403      REAL(wp), INTENT(in)  ::   pcalved 
    392404      REAL(wp), INTENT(in)  ::   pheated 
     
    411423      !!---------------------------------------------------------------------- 
    412424      ! 
    413       IF( .NOT. ln_bergdia ) RETURN 
     425      IF( .NOT.ln_bergdia )  RETURN 
    414426      ! 
    415427      IF( kt == nit000 ) THEN 
     
    437449      !!---------------------------------------------------------------------- 
    438450      !!---------------------------------------------------------------------- 
    439       INTEGER,  INTENT(in) :: ki, kj 
    440       REAL(wp), INTENT(in) :: pWn, pLn, pAbits, pmass_scale, pMnew, pnMbits, pz1_e1e2 
    441       !!---------------------------------------------------------------------- 
    442       ! 
    443       IF( .NOT. ln_bergdia ) RETURN 
     451      INTEGER , INTENT(in) ::  ki, kj 
     452      REAL(wp), INTENT(in) ::   pWn, pLn, pAbits, pmass_scale, pMnew, pnMbits, pz1_e1e2 
     453      !!---------------------------------------------------------------------- 
     454      ! 
     455      IF( .NOT.ln_bergdia )  RETURN 
    444456      virtual_area(ki,kj) = virtual_area(ki,kj) + ( pWn * pLn + pAbits ) * pmass_scale      ! m^2 
    445457      berg_mass(ki,kj)    = berg_mass(ki,kj) + pMnew * pz1_e1e2                             ! kg/m2 
     
    453465      !!---------------------------------------------------------------------- 
    454466      ! 
    455       IF( .NOT. ln_bergdia ) RETURN 
     467      IF( .NOT.ln_bergdia )  RETURN 
    456468      nspeeding_tickets = nspeeding_tickets + 1 
    457469      ! 
     
    459471 
    460472 
    461    SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat, pmass_scale,   & 
    462       &                   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   & 
    463       &                   pdMv, pz1_dt_e1e2 ) 
     473   SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat, pmass_scale,     & 
     474      &                    pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   & 
     475      &                    pdMv, pz1_dt_e1e2 ) 
    464476      !!---------------------------------------------------------------------- 
    465477      !!---------------------------------------------------------------------- 
     
    469481      !!---------------------------------------------------------------------- 
    470482      ! 
    471       IF( .NOT. ln_bergdia ) RETURN 
    472  
     483      IF( .NOT.ln_bergdia )  RETURN 
     484      ! 
    473485      berg_melt (ki,kj) = berg_melt (ki,kj) + pdM      * pz1_dt_e1e2   ! kg/m2/s 
    474486      bits_src  (ki,kj) = bits_src  (ki,kj) + pdMbitsE * pz1_dt_e1e2   ! mass flux into bergy bitskg/m2/s 
     
    492504      !!---------------------------------------------------------------------- 
    493505      ! 
    494       IF ( PRESENT(kbergs) ) THEN 
     506      IF( PRESENT(kbergs) ) THEN 
    495507         WRITE(numicb,100) cd_budgetstr // ' state:',                                    & 
    496                            cd_startstr  // ' start',  pstartval,         cd_budgetunits, & 
    497                            cd_endstr    // ' end',    pendval,           cd_budgetunits, & 
    498                            'Delta '     // cd_delstr, pendval-pstartval, cd_budgetunits, & 
    499                            '# of bergs', kbergs 
     508            &              cd_startstr  // ' start',  pstartval,         cd_budgetunits, & 
     509            &              cd_endstr    // ' end',    pendval,           cd_budgetunits, & 
     510            &              'Delta '     // cd_delstr, pendval-pstartval, cd_budgetunits, & 
     511            &              '# of bergs', kbergs 
    500512      ELSE 
    501513         WRITE(numicb,100) cd_budgetstr // ' state:',                                   & 
    502                            cd_startstr  // ' start', pstartval,         cd_budgetunits, & 
    503                            cd_endstr    // ' end',   pendval,           cd_budgetunits, & 
    504                            cd_delstr    // 'Delta',  pendval-pstartval, cd_budgetunits 
     514            &              cd_startstr  // ' start', pstartval,         cd_budgetunits, & 
     515            &              cd_endstr    // ' end',   pendval,           cd_budgetunits, & 
     516            &              cd_delstr    // 'Delta',  pendval-pstartval, cd_budgetunits 
    505517      ENDIF 
    506       100 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a12,i8) 
     518100   FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a12,i8) 
     519      ! 
    507520   END SUBROUTINE report_state 
    508521 
     
    516529      ! 
    517530      WRITE(numicb,200) cd_budgetstr // ' check:',                 & 
    518                         cd_startstr,    pstartval, cd_budgetunits, & 
    519                         cd_endstr,      pendval,   cd_budgetunits, & 
    520                         'error',        (pendval-pstartval)/((pendval+pstartval)+1e-30), 'nd' 
    521       200 FORMAT(a19,10(a18,"=",es14.7,x,a2,:,",")) 
     531         &              cd_startstr,    pstartval, cd_budgetunits, & 
     532         &              cd_endstr,      pendval,   cd_budgetunits, & 
     533         &              'error',        (pendval-pstartval)/((pendval+pstartval)+1e-30), 'nd' 
     534200   FORMAT(a19,10(a18,"=",es14.7,x,a2,:,",")) 
     535      ! 
    522536   END SUBROUTINE report_consistant 
    523537 
     
    530544      REAL(wp),      INTENT(in) :: pinval, poutval, pstartval, pendval 
    531545      ! 
    532       REAL(wp)                  :: zval 
     546      REAL(wp) ::  zval 
    533547      !!---------------------------------------------------------------------- 
    534548      ! 
    535549      zval = ( ( pendval - pstartval ) - ( pinval - poutval ) ) /   & 
    536          &   MAX( 1.e-30, MAX( abs( pendval - pstartval ) , ABS( pinval - poutval ) ) ) 
    537  
     550         &   MAX( 1.e-30, MAX( ABS( pendval - pstartval ) , ABS( pinval - poutval ) ) ) 
     551         ! 
    538552      WRITE(numicb,200) cd_budgetstr // ' budget:', & 
    539553         &              cd_instr     // ' in',      pinval,         cd_budgetunits, & 
     
    549563      !!---------------------------------------------------------------------- 
    550564      !!---------------------------------------------------------------------- 
    551       CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_startstr, cd_endstr, cd_delstr 
    552       INTEGER,       INTENT(in) :: pstartval, pendval 
     565      CHARACTER*(*), INTENT(in) ::   cd_budgetstr, cd_startstr, cd_endstr, cd_delstr 
     566      INTEGER      , INTENT(in) ::   pstartval, pendval 
     567      !!---------------------------------------------------------------------- 
    553568      ! 
    554569      WRITE(numicb,100) cd_budgetstr // ' state:',           & 
     
    570585      ! 
    571586      WRITE(numicb,200) cd_budgetstr // ' budget:', & 
    572                         cd_instr     // ' in',      pinval, & 
    573                         cd_outstr    // ' out',     poutval, & 
    574                         'Delta '     // cd_delstr,  pinval-poutval, & 
    575                         'error',                    ( ( pendval - pstartval ) - ( pinval - poutval ) ) 
    576       200 FORMAT(a19,10(a18,"=",i14,x,:,",")) 
     587         &              cd_instr     // ' in',      pinval, & 
     588         &              cd_outstr    // ' out',     poutval, & 
     589         &              'Delta '     // cd_delstr,  pinval-poutval, & 
     590         &              'error',                    ( ( pendval - pstartval ) - ( pinval - poutval ) ) 
     591200   FORMAT(a19,10(a18,"=",i14,x,:,",")) 
     592      ! 
    577593   END SUBROUTINE report_ibudget 
    578594 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90

    r5215 r9190  
    11MODULE icbdyn 
    2  
    32   !!====================================================================== 
    43   !!                       ***  MODULE  icbdyn  *** 
    54   !! Iceberg:  time stepping routine for iceberg tracking 
    65   !!====================================================================== 
    7    !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code 
    8    !!            -    !  2011-03  (Madec)          Part conversion to NEMO form 
    9    !!            -    !                            Removal of mapping from another grid 
    10    !!            -    !  2011-04  (Alderson)       Split into separate modules 
    11    !!            -    !  2011-05  (Alderson)       Replace broken grounding routine 
    12    !!            -    !                            with one of Gurvan's suggestions (just like 
    13    !!            -    !                            the broken one) 
     6   !! History :  3.3  !  2010-01  (Martin&Adcroft)  Original code 
     7   !!             -   !  2011-03  (Madec)  Part conversion to NEMO form 
     8   !!             -   !                    Removal of mapping from another grid 
     9   !!             -   !  2011-04  (Alderson)  Split into separate modules 
     10   !!             -   !  2011-05  (Alderson)  Replace broken grounding routine with one of 
     11   !!             -   !                       Gurvan's suggestions (just like the broken one) 
    1412   !!---------------------------------------------------------------------- 
    1513   USE par_oce        ! NEMO parameters 
     
    4139      !! ** Method  : - See Martin & Adcroft, Ocean Modelling 34, 2010 
    4240      !!---------------------------------------------------------------------- 
    43       REAL(wp)                        ::   zuvel1 , zvvel1 , zu1, zv1, zax1, zay1, zxi1 , zyj1 
    44       REAL(wp)                        ::   zuvel2 , zvvel2 , zu2, zv2, zax2, zay2, zxi2 , zyj2 
    45       REAL(wp)                        ::   zuvel3 , zvvel3 , zu3, zv3, zax3, zay3, zxi3 , zyj3 
    46       REAL(wp)                        ::   zuvel4 , zvvel4 , zu4, zv4, zax4, zay4, zxi4 , zyj4 
    47       REAL(wp)                        ::   zuvel_n, zvvel_n, zxi_n   , zyj_n 
    48       REAL(wp)                        ::   zdt, zdt_2, zdt_6, ze1, ze2 
    49       LOGICAL                         ::   ll_bounced 
    50       TYPE(iceberg), POINTER          ::   berg 
    51       TYPE(point)  , POINTER          ::   pt 
    52       INTEGER                         ::   kt 
    53       !!---------------------------------------------------------------------- 
    54  
     41      INTEGER, INTENT(in) ::   kt   ! 
     42      ! 
     43      LOGICAL  ::   ll_bounced 
     44      REAL(wp) ::   zuvel1 , zvvel1 , zu1, zv1, zax1, zay1, zxi1 , zyj1 
     45      REAL(wp) ::   zuvel2 , zvvel2 , zu2, zv2, zax2, zay2, zxi2 , zyj2 
     46      REAL(wp) ::   zuvel3 , zvvel3 , zu3, zv3, zax3, zay3, zxi3 , zyj3 
     47      REAL(wp) ::   zuvel4 , zvvel4 , zu4, zv4, zax4, zay4, zxi4 , zyj4 
     48      REAL(wp) ::   zuvel_n, zvvel_n, zxi_n   , zyj_n 
     49      REAL(wp) ::   zdt, zdt_2, zdt_6, ze1, ze2 
     50      TYPE(iceberg), POINTER ::   berg 
     51      TYPE(point)  , POINTER ::   pt 
     52      !!---------------------------------------------------------------------- 
     53      ! 
    5554      ! 4th order Runge-Kutta to solve:   d/dt X = V,  d/dt V = A 
    5655      !                    with I.C.'s:   X=X1 and V=V1 
     
    7574         pt => berg%current_point 
    7675 
    77          ll_bounced = .false. 
     76         ll_bounced = .FALSE. 
    7877 
    7978 
     
    9998         ! 
    10099         CALL icb_ground( zxi2, zxi1, zu1,   & 
    101          &                zyj2, zyj1, zv1, ll_bounced ) 
     100            &             zyj2, zyj1, zv1, ll_bounced ) 
    102101 
    103102         !                                         !**   A2 = A(X2,V2) 
     
    115114         ! 
    116115         CALL icb_ground( zxi3, zxi1, zu3,   & 
    117          &                zyj3, zyj1, zv3, ll_bounced ) 
     116            &                zyj3, zyj1, zv3, ll_bounced ) 
    118117 
    119118         !                                         !**   A3 = A(X3,V3) 
     
    131130 
    132131         CALL icb_ground( zxi4, zxi1, zu4,   & 
    133          &                zyj4, zyj1, zv4, ll_bounced ) 
     132            &             zyj4, zyj1, zv4, ll_bounced ) 
    134133 
    135134         !                                         !**   A4 = A(X4,V4) 
     
    150149 
    151150         CALL icb_ground( zxi_n, zxi1, zuvel_n,   & 
    152          &                      zyj_n, zyj1, zvvel_n, ll_bounced ) 
     151            &             zyj_n, zyj1, zvvel_n, ll_bounced ) 
    153152 
    154153         pt%uvel = zuvel_n                        !** save in berg structure 
     
    169168 
    170169   SUBROUTINE icb_ground( pi, pi0, pu,   & 
    171       &                         pj, pj0, pv, ld_bounced ) 
     170      &                   pj, pj0, pv, ld_bounced ) 
    172171      !!---------------------------------------------------------------------- 
    173172      !!                  ***  ROUTINE icb_ground  *** 
     
    216215      ibounce_method = 2 
    217216      SELECT CASE ( ibounce_method ) 
    218          CASE ( 1 ) 
    219             pi = pi0 
    220             pj = pj0 
    221             pu = 0._wp 
    222             pv = 0._wp 
    223          CASE ( 2 ) 
    224             IF( ii0 /= ii ) THEN 
    225                pi = pi0                   ! return back to the initial position 
    226                pu = 0._wp                 ! zeroing of velocity in the direction of the grounding 
    227             ENDIF 
    228             IF( ij0 /= ij ) THEN 
    229                pj = pj0                   ! return back to the initial position 
    230                pv = 0._wp                 ! zeroing of velocity in the direction of the grounding 
    231             ENDIF 
     217      CASE ( 1 ) 
     218         pi = pi0 
     219         pj = pj0 
     220         pu = 0._wp 
     221         pv = 0._wp 
     222      CASE ( 2 ) 
     223         IF( ii0 /= ii ) THEN 
     224            pi = pi0                   ! return back to the initial position 
     225            pu = 0._wp                 ! zeroing of velocity in the direction of the grounding 
     226         ENDIF 
     227         IF( ij0 /= ij ) THEN 
     228            pj = pj0                   ! return back to the initial position 
     229            pv = 0._wp                 ! zeroing of velocity in the direction of the grounding 
     230         ENDIF 
    232231      END SELECT 
    233232      ! 
     
    259258      ! 
    260259      INTEGER  ::   itloop 
    261       REAL(wp) ::   zuo, zvo, zui, zvi, zua, zva, zuwave, zvwave, zssh_x, zssh_y, zsst, zcn, zhi 
     260      REAL(wp) ::   zuo, zui, zua, zuwave, zssh_x, zsst, zcn, zhi 
     261      REAL(wp) ::   zvo, zvi, zva, zvwave, zssh_y 
    262262      REAL(wp) ::   zff, zT, zD, zW, zL, zM, zF 
    263263      REAL(wp) ::   zdrag_ocn, zdrag_atm, zdrag_ice, zwave_rad 
     
    339339            zaxe = zaxe - zdrag_ocn*(puvel -zuo) - zdrag_atm*(puvel -zua) -zdrag_ice*(puvel -zui) 
    340340            zaye = zaye - zdrag_ocn*(pvvel -zvo) - zdrag_atm*(pvvel -zva) -zdrag_ice*(pvvel -zvi) 
    341          endif 
     341         ENDIF 
    342342 
    343343         ! Solve for implicit accelerations 
     
    349349            pax     = zdetA * ( zA11*zaxe + zA12*zaye ) 
    350350            pay     = zdetA * ( zA11*zaye - zA12*zaxe ) 
    351          else 
     351         ELSE 
    352352            pax = zaxe   ;   pay = zaye 
    353          endif 
     353         ENDIF 
    354354 
    355355         zuveln = puvel0 + pdt*pax 
     
    362362         IF( zspeed > 0._wp ) THEN 
    363363            zloc_dx = MIN( pe1, pe2 )                          ! minimum grid spacing 
    364             zspeed_new = zloc_dx / pdt * rn_speed_limit     ! Speed limit as a factor of dx / dt 
     364            zspeed_new = zloc_dx / pdt * rn_speed_limit        ! Speed limit as a factor of dx / dt 
    365365            IF( zspeed_new < zspeed ) THEN 
    366366               zuveln = zuveln * ( zspeed_new / zspeed )        ! Scale velocity to reduce speed 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90

    r9168 r9190  
    361361      !!---------------------------------------------------------------------- 
    362362 
    363 #if !defined key_agrif 
     363#if defined key_agrif 
     364      IF(lwp) THEN 
     365         WRITE(numout,*) 
     366         WRITE(numout,*) 'icb_nam : AGRIF is not compatible with namelist namberg :  ' 
     367         WRITE(numout,*) '~~~~~~~   definition of rn_initial_mass(nclasses) with nclasses as PARAMETER ' 
     368         WRITE(numout,*) 
     369         WRITE(numout,*) '   ==>>>   force  NO icebergs used. The namelist namberg is not read' 
     370      ENDIF 
     371      ln_icebergs = .false.       
     372      RETURN 
     373#else 
     374      IF(lwp) THEN 
     375         WRITE(numout,*) 
     376         WRITE(numout,*) 'icb_nam : iceberg initialization through namberg namelist read' 
     377         WRITE(numout,*) '~~~~~~~~ ' 
     378      ENDIF 
     379#endif    
     380      !                             !==  read namelist  ==! 
    364381      REWIND( numnam_ref )              ! Namelist namberg in reference namelist : Iceberg parameters 
    365382      READ  ( numnam_ref, namberg, IOSTAT = ios, ERR = 901) 
     
    369386902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namberg in configuration namelist', lwp ) 
    370387      IF(lwm) WRITE ( numond, namberg ) 
    371 #else 
    372       IF(lwp) THEN 
    373          WRITE(numout,*) 
    374          WRITE(numout,*) 'icbini : AGRIF is not compatible with namelist namberg :  ' 
    375          WRITE(numout,*) '~~~~~~   definition of rn_initial_mass(nclasses) with nclasses as PARAMETER ' 
    376          WRITE(numout,*) '         ==>>>   force  NO icebergs used. The namelist namberg is not read' 
    377       ENDIF 
    378       ln_icebergs = .false.       
    379 #endif    
    380       IF( .NOT. ln_icebergs ) THEN   ! no icebergs 
    381          IF(lwp) THEN 
    382             WRITE(numout,*) 
    383             WRITE(numout,*) 'icbini : Namelist namberg ln_icebergs = F , NO icebergs used' 
    384             WRITE(numout,*) '~~~~~~ ' 
    385          ENDIF 
     388      ! 
     389      IF(lwp) WRITE(numout,*) 
     390      IF( ln_icebergs ) THEN 
     391         IF(lwp) WRITE(numout,*) '   ==>>>   icebergs are used' 
     392      ELSE 
     393         IF(lwp) WRITE(numout,*) '   ==>>>   No icebergs used' 
    386394         RETURN 
    387395      ENDIF 
    388  
    389  
    390 !     IF( lk_lim3 .AND. ln_icebergs ) THEN 
    391 !        CALL ctl_stop( 'icb_nam: the use of ICB with LIM3 not allowed. ice thickness missing in ICB' ) 
    392 !     ENDIF 
    393  
     396      ! 
     397      IF( nn_test_icebergs > nclasses ) THEN 
     398         IF(lwp) WRITE(numout,*) 
     399         IF(lwp) WRITE(numout,*) '   ==>>>   Resetting of nn_test_icebergs to ', nclasses 
     400         nn_test_icebergs = nclasses 
     401      ENDIF 
     402      ! 
    394403      IF(lwp) THEN                  ! control print 
    395404         WRITE(numout,*) 
     
    399408         WRITE(numout,*) '   Period between sampling of position for trajectory storage   nn_sample_rate = ', nn_sample_rate 
    400409         WRITE(numout,*) '   Mass thresholds between iceberg classes (kg)                 rn_initial_mass     =' 
    401          DO jn=1,nclasses 
    402             WRITE(numout,'(a,f15.2)') '                                                                ',rn_initial_mass(jn) 
     410         DO jn = 1, nclasses 
     411            WRITE(numout,'(a,f15.2)') '                                                                ', rn_initial_mass(jn) 
    403412         ENDDO 
    404413         WRITE(numout,*) '   Fraction of calving to apply to this class (non-dim)         rn_distribution     =' 
    405414         DO jn = 1, nclasses 
    406             WRITE(numout,'(a,f10.4)') '                                                                ',rn_distribution(jn) 
     415            WRITE(numout,'(a,f10.4)') '                                                                ', rn_distribution(jn) 
    407416         END DO 
    408417         WRITE(numout,*) '   Ratio between effective and real iceberg mass (non-dim)      rn_mass_scaling     = ' 
    409418         DO jn = 1, nclasses 
    410             WRITE(numout,'(a,f10.2)') '                                                                ',rn_mass_scaling(jn) 
     419            WRITE(numout,'(a,f10.2)') '                                                                ', rn_mass_scaling(jn) 
    411420         END DO 
    412421         WRITE(numout,*) '   Total thickness of newly calved bergs (m)                    rn_initial_thickness = ' 
    413422         DO jn = 1, nclasses 
    414             WRITE(numout,'(a,f10.2)') '                                                                ',rn_initial_thickness(jn) 
     423            WRITE(numout,'(a,f10.2)') '                                                                ', rn_initial_thickness(jn) 
    415424         END DO 
    416425         WRITE(numout,*) '   Timesteps between verbose messages                           nn_verbose_write    = ', nn_verbose_write 
     
    435444      ENDIF 
    436445      ! 
    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  
    442446      ! ensure that the sum of berg input distribution is equal to one 
    443447      zfact = SUM( rn_distribution ) 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90

    r5215 r9190  
    11MODULE icblbc 
    2  
    32   !!====================================================================== 
    43   !!                       ***  MODULE  icblbc  *** 
    54   !! Ocean physics:  routines to handle boundary exchanges for icebergs 
    65   !!====================================================================== 
    7    !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code 
    8    !!            -    !  2011-03  (Madec)          Part conversion to NEMO form 
    9    !!            -    !                            Removal of mapping from another grid 
    10    !!            -    !  2011-04  (Alderson)       Split into separate modules 
    11    !!            -    !  2011-05  (Alderson)       MPP exchanges written based on lib_mpp 
    12    !!            -    !  2011-05  (Alderson)       MPP and single processor boundary 
    13    !!            -    !                            conditions added 
     6   !! History :  3.3  !  2010-01  (Martin&Adcroft) Original code 
     7   !!             -   !  2011-03  (Madec)          Part conversion to NEMO form 
     8   !!             -   !                            Removal of mapping from another grid 
     9   !!             -   !  2011-04  (Alderson)       Split into separate modules 
     10   !!             -   !  2011-05  (Alderson)       MPP exchanges written based on lib_mpp 
     11   !!             -   !  2011-05  (Alderson)       MPP and single processor boundary conditions added 
    1412   !!---------------------------------------------------------------------- 
     13 
    1514   !!---------------------------------------------------------------------- 
    1615   !!   icb_lbc       : -  Pass icebergs across cyclic boundaries 
     
    2726   !!                         nicbfldpts  - packed i,j point in exchanging processor 
    2827   !!---------------------------------------------------------------------- 
    29  
    3028   USE par_oce                             ! ocean parameters 
    3129   USE dom_oce                             ! ocean domain 
     
    4543 
    4644   TYPE, PUBLIC :: buffer 
    47       INTEGER :: size=0 
    48       REAL(wp), DIMENSION(:,:), POINTER :: data 
     45      INTEGER :: size = 0 
     46      REAL(wp), DIMENSION(:,:), POINTER ::   data 
    4947   END TYPE buffer 
    5048 
    51    TYPE(buffer), POINTER           ::   obuffer_n=>NULL() , ibuffer_n=>NULL() 
    52    TYPE(buffer), POINTER           ::   obuffer_s=>NULL() , ibuffer_s=>NULL() 
    53    TYPE(buffer), POINTER           ::   obuffer_e=>NULL() , ibuffer_e=>NULL() 
    54    TYPE(buffer), POINTER           ::   obuffer_w=>NULL() , ibuffer_w=>NULL() 
     49   TYPE(buffer), POINTER       ::   obuffer_n=>NULL() , ibuffer_n=>NULL() 
     50   TYPE(buffer), POINTER       ::   obuffer_s=>NULL() , ibuffer_s=>NULL() 
     51   TYPE(buffer), POINTER       ::   obuffer_e=>NULL() , ibuffer_e=>NULL() 
     52   TYPE(buffer), POINTER       ::   obuffer_w=>NULL() , ibuffer_w=>NULL() 
    5553 
    5654   ! north fold exchange buffers 
    57    TYPE(buffer), POINTER           ::   obuffer_f=>NULL() , ibuffer_f=>NULL() 
    58  
    59    INTEGER, PARAMETER, PRIVATE     ::   jp_delta_buf = 25             ! Size by which to increment buffers 
    60    INTEGER, PARAMETER, PRIVATE     ::   jp_buffer_width = 15+nkounts  ! items to store for each berg 
     55   TYPE(buffer), POINTER       ::   obuffer_f=>NULL() , ibuffer_f=>NULL() 
     56 
     57   INTEGER, PARAMETER, PRIVATE ::   jp_delta_buf = 25             ! Size by which to increment buffers 
     58   INTEGER, PARAMETER, PRIVATE ::   jp_buffer_width = 15+nkounts  ! items to store for each berg 
    6159 
    6260#endif 
     
    926924      WRITE(numout,*) 'icb_lbc_mpp: You should not have seen this message!!' 
    927925   END SUBROUTINE icb_lbc_mpp 
    928  
    929926#endif 
    930927 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90

    r6623 r9190  
    11MODULE icbrst 
    2  
    32   !!====================================================================== 
    43   !!                       ***  MODULE  icbrst  *** 
     
    1514   !!                                              read single restart files 
    1615   !!---------------------------------------------------------------------- 
     16 
    1717   !!---------------------------------------------------------------------- 
    1818   !!   icb_rst_read    : read restart file 
     
    110110               CALL iom_get( ncid, 'mass_of_bits' , localpt%mass_of_bits  , ktime=jn ) 
    111111               CALL iom_get( ncid, 'heat_density' , localpt%heat_density  , ktime=jn ) 
    112  
    113112               ! 
    114113               CALL icb_utl_add( localberg, localpt ) 
    115  
     114               ! 
    116115            ENDIF 
    117  
     116            ! 
    118117         END DO 
    119  
     118         ! 
    120119      ENDIF  
    121120 
     
    144143      CALL iom_close( ncid ) 
    145144      ! 
    146       IF( lwp .and. nn_verbose_level >= 0)  WRITE(numout,'(a)') 'icebergs, read_restart_bergs: completed' 
     145      IF( lwp .AND. nn_verbose_level >= 0)  WRITE(numout,'(a)') 'icebergs, read_restart_bergs: completed' 
    147146      ! 
    148147   END SUBROUTINE icb_rst_read 
     
    361360   END SUBROUTINE icb_rst_write 
    362361   ! 
     362   !!====================================================================== 
    363363END MODULE icbrst 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90

    r9124 r9190  
    171171   END SUBROUTINE icb_end 
    172172 
    173    !!------------------------------------------------------------------------- 
     173   !!====================================================================== 
    174174END MODULE icbstp 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90

    r5836 r9190  
    11MODULE icbthm 
    2  
    32   !!====================================================================== 
    43   !!                       ***  MODULE  icbthm  *** 
     
    3130   PUBLIC   icb_thm ! routine called in icbstp.F90 module 
    3231 
     32   !!---------------------------------------------------------------------- 
     33   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
    3334   !! $Id$ 
     35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     36   !!---------------------------------------------------------------------- 
    3437CONTAINS 
    3538 
     
    5558      ! 
    5659      z1_rday = 1._wp / rday 
    57        
     60      ! 
    5861      ! we're either going to ignore berg fresh water melt flux and associated heat 
    5962      ! or we pass it into the ocean, so at this point we set them both to zero, 
     
    6366      berg_grid%floating_melt(:,:) = 0._wp 
    6467      berg_grid%calving_hflx(:,:)  = 0._wp 
    65      
     68      ! 
    6669      this => first_berg 
    67       DO WHILE( associated(this) ) 
     70      DO WHILE( ASSOCIATED(this) ) 
    6871         ! 
    6972         pt => this%current_point 
    7073         nknberg = this%number(1) 
    71          CALL icb_utl_interp( pt%xi, pt%e1, pt%uo, pt%ui, pt%ua, pt%ssh_x, & 
    72          &                    pt%yj, pt%e2, pt%vo, pt%vi, pt%va, pt%ssh_y, & 
    73          &                 pt%sst, pt%cn, pt%hi, zff ) 
     74         CALL icb_utl_interp( pt%xi, pt%e1, pt%uo, pt%ui, pt%ua, pt%ssh_x,   & 
     75            &                 pt%yj, pt%e2, pt%vo, pt%vi, pt%va, pt%ssh_y,  & 
     76            &                 pt%sst, pt%cn, pt%hi, zff ) 
    7477         ! 
    7578         zSST = pt%sst 
     
    98101         zMv = MAX( 7.62e-3*zSST+1.29e-3*(zSST**2)            , 0._wp ) * z1_rday   ! Buoyant convection at sides (eqn M.A10) 
    99102         zMb = MAX( 0.58*(zdvo**0.8)*(zSST+4.0)/(zL**0.2)      , 0._wp ) * z1_rday   ! Basal turbulent melting     (eqn M.A7 ) 
    100          zMe = MAX( 1./12.*(zSST+2.)*zSs*(1+cos(rpi*(zIC**3))) , 0._wp ) * z1_rday   ! Wave erosion                (eqn M.A8 ) 
     103         zMe = MAX( 1./12.*(zSST+2.)*zSs*(1+COS(rpi*(zIC**3))) , 0._wp ) * z1_rday   ! Wave erosion                (eqn M.A8 ) 
    101104 
    102105         IF( ln_operator_splitting ) THEN      ! Operator split update of volume/mass 
    103106            zTn    = MAX( zT - zMb*zdt , 0._wp )         ! new total thickness (m) 
    104             znVol  = zTn * zW * zL                        ! new volume (m^3) 
    105             zMnew1 = (znVol/zVol) * zM                    ! new mass (kg) 
     107            znVol  = zTn * zW * zL                       ! new volume (m^3) 
     108            zMnew1 = (znVol/zVol) * zM                   ! new mass (kg) 
    106109            zdMb   = zM - zMnew1                         ! mass lost to basal melting (>0) (kg) 
    107110            ! 
    108111            zLn    = MAX( zL - zMv*zdt , 0._wp )         ! new length (m) 
    109112            zWn    = MAX( zW - zMv*zdt , 0._wp )         ! new width (m) 
    110             znVol  = zTn * zWn * zLn                      ! new volume (m^3) 
    111             zMnew2 = (znVol/zVol) * zM                    ! new mass (kg) 
     113            znVol  = zTn * zWn * zLn                     ! new volume (m^3) 
     114            zMnew2 = (znVol/zVol) * zM                   ! new mass (kg) 
    112115            zdMv   = zMnew1 - zMnew2                     ! mass lost to buoyant convection (>0) (kg) 
    113116            ! 
    114117            zLn    = MAX( zLn - zMe*zdt , 0._wp )        ! new length (m) 
    115118            zWn    = MAX( zWn - zMe*zdt , 0._wp )        ! new width (m) 
    116             znVol  = zTn * zWn * zLn                      ! new volume (m^3) 
    117             zMnew  = ( znVol / zVol ) * zM                ! new mass (kg) 
     119            znVol  = zTn * zWn * zLn                     ! new volume (m^3) 
     120            zMnew  = ( znVol / zVol ) * zM               ! new mass (kg) 
    118121            zdMe   = zMnew2 - zMnew                      ! mass lost to erosion (>0) (kg) 
    119122            zdM    = zM - zMnew                          ! mass lost to all erosion and melting (>0) (kg) 
    120123            ! 
    121124         ELSE                                         ! Update dimensions of berg 
    122             zLn = MAX( zL -(zMv+zMe)*zdt ,0._wp )         ! (m) 
    123             zWn = MAX( zW -(zMv+zMe)*zdt ,0._wp )         ! (m) 
     125            zLn = MAX( zL -(zMv+zMe)*zdt ,0._wp )        ! (m) 
     126            zWn = MAX( zW -(zMv+zMe)*zdt ,0._wp )        ! (m) 
    124127            zTn = MAX( zT - zMb    *zdt ,0._wp )         ! (m) 
    125128            ! Update volume and mass of berg 
    126             znVol = zTn*zWn*zLn                           ! (m^3) 
    127             zMnew = (znVol/zVol)*zM                       ! (kg) 
     129            znVol = zTn*zWn*zLn                          ! (m^3) 
     130            zMnew = (znVol/zVol)*zM                      ! (kg) 
    128131            zdM   = zM - zMnew                           ! (kg) 
    129             zdMb = (zM/zVol) * (zW*   zL ) *zMb*zdt         ! approx. mass loss to basal melting (kg) 
    130             zdMe = (zM/zVol) * (zT*(zW+zL)) *zMe*zdt         ! approx. mass lost to erosion (kg) 
    131             zdMv = (zM/zVol) * (zT*(zW+zL)) *zMv*zdt         ! approx. mass loss to buoyant convection (kg) 
    132          ENDIF 
    133  
    134          IF( rn_bits_erosion_fraction > 0._wp ) THEN      ! Bergy bits 
     132            zdMb = (zM/zVol) * (zW*   zL ) *zMb*zdt      ! approx. mass loss to basal melting (kg) 
     133            zdMe = (zM/zVol) * (zT*(zW+zL)) *zMe*zdt     ! approx. mass lost to erosion (kg) 
     134            zdMv = (zM/zVol) * (zT*(zW+zL)) *zMv*zdt     ! approx. mass loss to buoyant convection (kg) 
     135         ENDIF 
     136 
     137         IF( rn_bits_erosion_fraction > 0._wp ) THEN     ! Bergy bits 
    135138            ! 
    136139            zMbits   = pt%mass_of_bits                                               ! mass of bergy bits (kg) 
    137             zdMbitsE = rn_bits_erosion_fraction * zdMe                        ! change in mass of bits (kg) 
    138             znMbits  = zMbits + zdMbitsE                                               ! add new bergy bits to mass (kg) 
    139             zLbits   = MIN( zL, zW, zT, 40._wp )                                        ! assume bergy bits are smallest dimension or 40 meters 
    140             zAbits   = ( zMbits / rn_rho_bergs ) / zLbits                           ! Effective bottom area (assuming T=Lbits) 
    141             zMbb     = MAX( 0.58*(zdvo**0.8)*(zSST+2.0)/(zLbits**0.2), 0.) * z1_rday    ! Basal turbulent melting (for bits) 
    142             zMbb     = rn_rho_bergs * zAbits * zMbb                                 ! in kg/s 
    143             zdMbitsM = MIN( zMbb*zdt , znMbits )                                       ! bergy bits mass lost to melting (kg) 
    144             znMbits  = znMbits-zdMbitsM                                                ! remove mass lost to bergy bits melt 
     140            zdMbitsE = rn_bits_erosion_fraction * zdMe                               ! change in mass of bits (kg) 
     141            znMbits  = zMbits + zdMbitsE                                             ! add new bergy bits to mass (kg) 
     142            zLbits   = MIN( zL, zW, zT, 40._wp )                                     ! assume bergy bits are smallest dimension or 40 meters 
     143            zAbits   = ( zMbits / rn_rho_bergs ) / zLbits                            ! Effective bottom area (assuming T=Lbits) 
     144            zMbb     = MAX( 0.58*(zdvo**0.8)*(zSST+2.0)/(zLbits**0.2), 0.) * z1_rday ! Basal turbulent melting (for bits) 
     145            zMbb     = rn_rho_bergs * zAbits * zMbb                                  ! in kg/s 
     146            zdMbitsM = MIN( zMbb*zdt , znMbits )                                     ! bergy bits mass lost to melting (kg) 
     147            znMbits  = znMbits-zdMbitsM                                              ! remove mass lost to bergy bits melt 
    145148            IF( zMnew == 0._wp ) THEN                                                ! if parent berg has completely melted then 
    146                zdMbitsM = zdMbitsM + znMbits                                           ! instantly melt all the bergy bits 
     149               zdMbitsM = zdMbitsM + znMbits                                         ! instantly melt all the bergy bits 
    147150               znMbits  = 0._wp 
    148151            ENDIF 
     
    163166            berg_grid%calving_hflx (ii,ij) = berg_grid%calving_hflx (ii,ij) + zheat    * z1_e1e2    ! W/m2 
    164167            CALL icb_dia_melt( ii, ij, zMnew, zheat, this%mass_scaling,       & 
    165             &                          zdM, zdMbitsE, zdMbitsM, zdMb, zdMe,   & 
    166             &                          zdMv, z1_dt_e1e2 ) 
     168               &                       zdM, zdMbitsE, zdMbitsM, zdMb, zdMe,   & 
     169               &                       zdMv, z1_dt_e1e2 ) 
    167170         ELSE 
    168171            WRITE(numout,*) 'icb_thm: berg ',this%number(:),' appears to have grounded  at ',narea,ii,ij 
     
    178181            zTn = zWn 
    179182            zWn = zT 
    180          endif 
     183         ENDIF 
    181184 
    182185         ! Store the new state of iceberg (with L>W) 
     
    184187         pt%mass_of_bits = znMbits 
    185188         pt%thickness    = zTn 
    186          pt%width        = min(zWn,zLn) 
    187          pt%length       = max(zWn,zLn) 
     189         pt%width        = MIN( zWn , zLn ) 
     190         pt%length       = MAX( zWn , zLn ) 
    188191 
    189192         next=>this%next 
     
    197200            z1_e1e2 = r1_e1e2t(ii,ij) * this%mass_scaling 
    198201            CALL icb_dia_size( ii, ij, zWn, zLn, zAbits,   & 
    199             &                  this%mass_scaling, zMnew, znMbits, z1_e1e2) 
     202               &               this%mass_scaling, zMnew, znMbits, z1_e1e2 ) 
    200203         ENDIF 
    201204         ! 
     
    203206         ! 
    204207      END DO 
    205        
     208 
    206209      ! now use melt and associated heat flux in ocean (or not) 
    207210      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90

    r9019 r9190  
    11MODULE icbtrj 
    2  
    32   !!====================================================================== 
    43   !!                       ***  MODULE  icbtrj  *** 
    54   !! Ocean physics:  trajectory I/O routines 
    65   !!====================================================================== 
    7    !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code 
    8    !!            -    !  2011-03  (Madec)          Part conversion to NEMO form 
    9    !!            -    !                            Removal of mapping from another grid 
    10    !!            -    !  2011-05  (Alderson)       New module to handle trajectory output 
    11    !!---------------------------------------------------------------------- 
    12    !!---------------------------------------------------------------------- 
    13    !!   icb_trj_init          : 
     6   !! History :  3.3  !  2010-01  (Martin&Adcroft) Original code 
     7   !!             -   !  2011-03  (Madec)          Part conversion to NEMO form 
     8   !!             -   !                            Removal of mapping from another grid 
     9   !!             -   !  2011-05  (Alderson)       New module to handle trajectory output 
     10   !!---------------------------------------------------------------------- 
     11 
     12   !!---------------------------------------------------------------------- 
     13   !!   icb_trj_init  : 
     14   !!   icb_trj_write : 
     15   !!   icb_trj_sync  : 
     16   !!   icb_trj_end   : 
    1417   !!---------------------------------------------------------------------- 
    1518   USE par_oce        ! NEMO parameters 
     
    4952   !!---------------------------------------------------------------------- 
    5053CONTAINS 
    51  
    52    !!------------------------------------------------------------------------- 
    5354 
    5455   SUBROUTINE icb_trj_init( ktend ) 
     
    252253   END SUBROUTINE icb_trj_write 
    253254 
    254    !!------------------------------------------------------------------------- 
    255255 
    256256   SUBROUTINE icb_trj_sync() 
     
    260260      !! ** Purpose :    
    261261      !!---------------------------------------------------------------------- 
    262       INTEGER                               :: iret 
     262      INTEGER ::  iret 
    263263      !!---------------------------------------------------------------------- 
    264264      ! flush to file 
     
    270270 
    271271   SUBROUTINE icb_trj_end() 
    272       ! Local variables 
    273       INTEGER                               :: iret 
     272      !!---------------------------------------------------------------------- 
     273      INTEGER ::  iret 
    274274      !!---------------------------------------------------------------------- 
    275275      ! Finish up 
     
    279279   END SUBROUTINE icb_trj_end 
    280280 
    281    !!------------------------------------------------------------------------- 
    282  
     281   !!====================================================================== 
    283282END MODULE icbtrj 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90

    r9019 r9190  
    99   !!            -    !  2011-04  (Alderson)       Split into separate modules 
    1010   !!---------------------------------------------------------------------- 
     11 
    1112   !!---------------------------------------------------------------------- 
    1213   !!   icb_utl_interp   : 
     
    4849   !! $Id$ 
    4950   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    50    !!------------------------------------------------------------------------- 
    51  
     51   !!---------------------------------------------------------------------- 
    5252CONTAINS 
    5353 
     
    6565      ! and ssh which is used to calculate gradients 
    6666 
    67       uo_e(:,:) = 0._wp ;   uo_e(1:jpi, 1:jpj) = ssu_m(:,:) * umask(:,:,1) 
    68       vo_e(:,:) = 0._wp ;   vo_e(1:jpi, 1:jpj) = ssv_m(:,:) * vmask(:,:,1) 
    69       ff_e(:,:) = 0._wp ;   ff_e(1:jpi, 1:jpj) = ff_f (:,:)  
    70       tt_e(:,:) = 0._wp ;   tt_e(1:jpi, 1:jpj) = sst_m(:,:) 
    71       fr_e(:,:) = 0._wp ;   fr_e(1:jpi, 1:jpj) = fr_i (:,:) 
    72       ua_e(:,:) = 0._wp ;   ua_e(1:jpi, 1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
    73       va_e(:,:) = 0._wp ;   va_e(1:jpi, 1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
    74  
     67      uo_e(:,:) = 0._wp   ;   uo_e(1:jpi,1:jpj) = ssu_m(:,:) * umask(:,:,1) 
     68      vo_e(:,:) = 0._wp   ;   vo_e(1:jpi,1:jpj) = ssv_m(:,:) * vmask(:,:,1) 
     69      ff_e(:,:) = 0._wp   ;   ff_e(1:jpi,1:jpj) = ff_f (:,:)  
     70      tt_e(:,:) = 0._wp   ;   tt_e(1:jpi,1:jpj) = sst_m(:,:) 
     71      fr_e(:,:) = 0._wp   ;   fr_e(1:jpi,1:jpj) = fr_i (:,:) 
     72      ua_e(:,:) = 0._wp   ;   ua_e(1:jpi,1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
     73      va_e(:,:) = 0._wp   ;   va_e(1:jpi,1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
     74      ! 
    7575      CALL lbc_lnk_icb( uo_e, 'U', -1._wp, 1, 1 ) 
    7676      CALL lbc_lnk_icb( vo_e, 'V', -1._wp, 1, 1 ) 
     
    8484      ui_e(:,:) = 0._wp ;   ui_e(1:jpi, 1:jpj) = u_ice(:,:) 
    8585      vi_e(:,:) = 0._wp ;   vi_e(1:jpi, 1:jpj) = v_ice(:,:) 
    86       CALL lbc_lnk_icb(hicth, 'T', +1._wp, 1, 1 ) 
    87       CALL lbc_lnk_icb( ui_e, 'U', -1._wp, 1, 1 ) 
    88       CALL lbc_lnk_icb( vi_e, 'V', -1._wp, 1, 1 ) 
     86      ! 
     87      CALL lbc_lnk_icb( hicth, 'T', +1._wp, 1, 1 ) 
     88      CALL lbc_lnk_icb( ui_e , 'U', -1._wp, 1, 1 ) 
     89      CALL lbc_lnk_icb( vi_e , 'V', -1._wp, 1, 1 ) 
    8990#endif 
    9091 
     
    149150 
    150151#if defined key_lim3 
    151       pui = icb_utl_bilin_h( ui_e, pi, pj, 'U' )              ! sea-ice velocities 
    152       pvi = icb_utl_bilin_h( vi_e, pi, pj, 'V' ) 
    153       phi = icb_utl_bilin_h(hicth, pi, pj, 'T' )              ! ice thickness 
     152      pui = icb_utl_bilin_h( ui_e , pi, pj, 'U' )              ! sea-ice velocities 
     153      pvi = icb_utl_bilin_h( vi_e , pi, pj, 'V' ) 
     154      phi = icb_utl_bilin_h( hicth, pi, pj, 'T' )              ! ice thickness 
    154155#else 
    155156      pui = 0._wp 
     
    160161      ! Estimate SSH gradient in i- and j-direction (centred evaluation) 
    161162      pssh_i = ( icb_utl_bilin_h( ssh_e, pi+0.1_wp, pj, 'T' ) -   & 
    162           &      icb_utl_bilin_h( ssh_e, pi-0.1_wp, pj, 'T' )  ) / ( 0.2_wp * pe1 ) 
     163         &       icb_utl_bilin_h( ssh_e, pi-0.1_wp, pj, 'T' )  ) / ( 0.2_wp * pe1 ) 
    163164      pssh_j = ( icb_utl_bilin_h( ssh_e, pi, pj+0.1_wp, 'T' ) -   & 
    164           &      icb_utl_bilin_h( ssh_e, pi, pj-0.1_wp, 'T' )  ) / ( 0.2_wp * pe2 ) 
     165         &       icb_utl_bilin_h( ssh_e, pi, pj-0.1_wp, 'T' )  ) / ( 0.2_wp * pe2 ) 
    165166      ! 
    166167   END SUBROUTINE icb_utl_interp 
     
    181182      REAL(wp)                            , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential 
    182183      CHARACTER(len=1)                    , INTENT(in) ::   cd_type   ! type of pfld array grid-points: = T , U , V or F points 
     184      ! 
     185      INTEGER  ::   ii, ij   ! local integer 
     186      REAL(wp) ::   zi, zj   ! local real 
     187      !!---------------------------------------------------------------------- 
     188      ! 
     189      SELECT CASE ( cd_type ) 
     190      CASE ( 'T' ) 
     191         ! note that here there is no +0.5 added 
     192         ! since we're looking for four T points containing quadrant we're in of  
     193         ! current T cell 
     194         ii = MAX(1, INT( pi     )) 
     195         ij = MAX(1, INT( pj     ))    ! T-point 
     196         zi = pi - REAL(ii,wp) 
     197         zj = pj - REAL(ij,wp) 
     198      CASE ( 'U' ) 
     199         ii = MAX(1, INT( pi-0.5 )) 
     200         ij = MAX(1, INT( pj     ))    ! U-point 
     201         zi = pi - 0.5 - REAL(ii,wp) 
     202         zj = pj - REAL(ij,wp) 
     203      CASE ( 'V' ) 
     204         ii = MAX(1, INT( pi     )) 
     205         ij = MAX(1, INT( pj-0.5 ))    ! V-point 
     206         zi = pi - REAL(ii,wp) 
     207         zj = pj - 0.5 - REAL(ij,wp) 
     208      CASE ( 'F' ) 
     209         ii = MAX(1, INT( pi-0.5 )) 
     210         ij = MAX(1, INT( pj-0.5 ))    ! F-point 
     211         zi = pi - 0.5 - REAL(ii,wp) 
     212         zj = pj - 0.5 - REAL(ij,wp) 
     213      END SELECT 
     214      ! 
     215      ! find position in this processor. Prevent near edge problems (see #1389) 
     216      ! 
     217      IF    ( ii < mig( 1 ) ) THEN   ;   ii = 1 
     218      ELSEIF( ii > mig(jpi) ) THEN   ;   ii = jpi 
     219      ELSE                           ;   ii = mi1(ii) 
     220      ENDIF 
     221      IF    ( ij < mjg( 1 ) ) THEN   ;   ij = 1 
     222      ELSEIF( ij > mjg(jpj) ) THEN   ;   ij = jpj 
     223      ELSE                           ;   ij  = mj1(ij) 
     224      ENDIF 
     225      ! 
     226      IF( ii == jpi )   ii = ii-1       
     227      IF( ij == jpj )   ij = ij-1 
     228      ! 
     229      icb_utl_bilin_h = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   & 
     230         &            + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) *     zj 
     231      ! 
     232   END FUNCTION icb_utl_bilin_h 
     233 
     234 
     235   REAL(wp) FUNCTION icb_utl_bilin( pfld, pi, pj, cd_type ) 
     236      !!---------------------------------------------------------------------- 
     237      !!                  ***  FUNCTION icb_utl_bilin  *** 
     238      !! 
     239      !! ** Purpose :   bilinear interpolation at berg location depending on the grid-point type 
     240      !! 
     241      !!       !!gm  CAUTION an optional argument should be added to handle 
     242      !!             the slip/no-slip conditions  ==>>> to be done later 
     243      !! 
     244      !!---------------------------------------------------------------------- 
     245      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfld      ! field to be interpolated 
     246      REAL(wp)                    , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential 
     247      CHARACTER(len=1)            , INTENT(in) ::   cd_type   ! type of pfld array grid-points: = T , U , V or F points 
    183248      ! 
    184249      INTEGER  ::   ii, ij   ! local integer 
     
    213278      ! 
    214279      ! find position in this processor. Prevent near edge problems (see #1389) 
    215  
    216       if (ii.lt.mig(1)) then 
    217         ii = 1 
    218       else if (ii.gt.mig(jpi)) then 
    219         ii = jpi 
    220       else 
    221         ii  = mi1( ii  ) 
    222       end if 
    223  
    224       if (ij.lt.mjg(1)) then 
    225         ij = 1 
    226       else if (ij.gt.mjg(jpj)) then 
    227         ij = jpj 
    228       else 
    229         ij  = mj1( ij  ) 
    230       end if 
    231  
    232       if (ij.eq.jpj) ij=ij-1 
    233       if (ii.eq.jpi) ii=ii-1       
    234  
    235       ! 
    236       icb_utl_bilin_h = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   & 
    237          &            + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) *     zj 
    238       ! 
    239    END FUNCTION icb_utl_bilin_h 
    240  
    241  
    242    REAL(wp) FUNCTION icb_utl_bilin( pfld, pi, pj, cd_type ) 
    243       !!---------------------------------------------------------------------- 
    244       !!                  ***  FUNCTION icb_utl_bilin  *** 
    245       !! 
    246       !! ** Purpose :   bilinear interpolation at berg location depending on the grid-point type 
    247       !! 
    248       !!       !!gm  CAUTION an optional argument should be added to handle 
    249       !!             the slip/no-slip conditions  ==>>> to be done later 
    250       !! 
    251       !!---------------------------------------------------------------------- 
    252       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfld      ! field to be interpolated 
    253       REAL(wp)                    , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential 
    254       CHARACTER(len=1)            , INTENT(in) ::   cd_type   ! type of pfld array grid-points: = T , U , V or F points 
    255       ! 
    256       INTEGER  ::   ii, ij   ! local integer 
    257       REAL(wp) ::   zi, zj   ! local real 
    258       !!---------------------------------------------------------------------- 
    259       ! 
    260       SELECT CASE ( cd_type ) 
    261          CASE ( 'T' ) 
    262             ! note that here there is no +0.5 added 
    263             ! since we're looking for four T points containing quadrant we're in of  
    264             ! current T cell 
    265             ii = MAX(1, INT( pi     )) 
    266             ij = MAX(1, INT( pj     ))    ! T-point 
    267             zi = pi - REAL(ii,wp) 
    268             zj = pj - REAL(ij,wp) 
    269          CASE ( 'U' ) 
    270             ii = MAX(1, INT( pi-0.5 )) 
    271             ij = MAX(1, INT( pj     ))    ! U-point 
    272             zi = pi - 0.5 - REAL(ii,wp) 
    273             zj = pj - REAL(ij,wp) 
    274          CASE ( 'V' ) 
    275             ii = MAX(1, INT( pi     )) 
    276             ij = MAX(1, INT( pj-0.5 ))    ! V-point 
    277             zi = pi - REAL(ii,wp) 
    278             zj = pj - 0.5 - REAL(ij,wp) 
    279          CASE ( 'F' ) 
    280             ii = MAX(1, INT( pi-0.5 )) 
    281             ij = MAX(1, INT( pj-0.5 ))    ! F-point 
    282             zi = pi - 0.5 - REAL(ii,wp) 
    283             zj = pj - 0.5 - REAL(ij,wp) 
    284       END SELECT 
    285       ! 
    286       ! find position in this processor. Prevent near edge problems (see #1389) 
    287  
    288       if (ii.lt.mig(1)) then 
    289         ii = 1 
    290       else if (ii.gt.mig(jpi)) then 
    291         ii = jpi 
    292       else 
    293         ii  = mi1( ii  ) 
    294       end if 
    295  
    296       if (ij.lt.mjg(1)) then 
    297         ij = 1 
    298       else if (ij.gt.mjg(jpj)) then 
    299         ij = jpj 
    300       else 
    301         ij  = mj1( ij  ) 
    302       end if 
    303  
    304       if (ij.eq.jpj) ij=ij-1 
    305       if (ii.eq.jpi) ii=ii-1 
    306  
     280      IF    ( ii < mig( 1 ) ) THEN   ;   ii = 1 
     281      ELSEIF( ii > mig(jpi) ) THEN   ;   ii = jpi 
     282      ELSE                           ;   ii = mi1(ii) 
     283      ENDIF 
     284      IF    ( ij < mjg( 1 ) ) THEN   ;   ij = 1 
     285      ELSEIF( ij > mjg(jpj) ) THEN   ;   ij = jpj 
     286      ELSE                           ;   ij  = mj1(ij) 
     287      ENDIF 
     288      ! 
     289      IF( ii == jpi )   ii = ii-1       
     290      IF( ij == jpj )   ij = ij-1 
     291      ! 
    307292      icb_utl_bilin = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   & 
    308293         &          + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) *     zj 
     
    340325      ! 
    341326      ! find position in this processor. Prevent near edge problems (see #1389) 
    342  
    343       if (ii.lt.mig(1)) then 
    344         ii = 1 
    345       else if (ii.gt.mig(jpi)) then 
    346         ii = jpi 
    347       else 
    348         ii  = mi1( ii  ) 
    349       end if 
    350  
    351       if (ij.lt.mjg(1)) then 
    352         ij = 1 
    353       else if (ij.gt.mjg(jpj)) then 
    354         ij = jpj 
    355       else 
    356         ij  = mj1( ij  ) 
    357       end if 
    358  
    359       if (ij.eq.jpj) ij=ij-1 
    360       if (ii.eq.jpi) ii=ii-1 
    361  
     327      IF    ( ii < mig( 1 ) ) THEN   ;   ii = 1 
     328      ELSEIF( ii > mig(jpi) ) THEN   ;   ii = jpi 
     329      ELSE                           ;   ii = mi1(ii) 
     330      ENDIF 
     331      IF    ( ij < mjg( 1 ) ) THEN   ;   ij = 1 
     332      ELSEIF( ij > mjg(jpj) ) THEN   ;   ij = jpj 
     333      ELSE                           ;   ij  = mj1(ij) 
     334      ENDIF 
     335      ! 
     336      IF( ii == jpi )   ii = ii-1       
     337      IF( ij == jpj )   ij = ij-1 
     338      ! 
    362339      z4(1) = pfld(ii  ,ij  ) 
    363340      z4(2) = pfld(ii+1,ij  ) 
     
    408385 
    409386      ! find position in this processor. Prevent near edge problems (see #1389) 
    410  
    411       if (ii.lt.mig(1)) then 
    412         ii = 1 
    413       else if (ii.gt.mig(jpi)) then 
    414         ii = jpi 
    415       else 
    416         ii  = mi1( ii  ) 
    417       end if 
    418  
    419       if (ij.lt.mjg(1)) then 
    420         ij = 1 
    421       else if (ij.gt.mjg(jpj)) then 
    422         ij = jpj 
    423       else 
    424         ij  = mj1( ij  ) 
    425       end if 
    426  
    427       if (ij.eq.jpj) ij=ij-1 
    428       if (ii.eq.jpi) ii=ii-1 
    429  
     387      IF    ( ii < mig( 1 ) ) THEN   ;   ii = 1 
     388      ELSEIF( ii > mig(jpi) ) THEN   ;   ii = jpi 
     389      ELSE                           ;   ii = mi1(ii) 
     390      ENDIF 
     391      IF    ( ij < mjg( 1 ) ) THEN   ;   ij = 1 
     392      ELSEIF( ij > mjg(jpj) ) THEN   ;   ij = jpj 
     393      ELSE                           ;   ij  = mj1(ij) 
     394      ENDIF 
     395      ! 
     396      IF( ii == jpi )   ii = ii-1       
     397      IF( ij == jpj )   ij = ij-1 
     398      ! 
    430399      IF(    0.0_wp <= zi .AND. zi < 0.5_wp   ) THEN 
    431400         IF( 0.0_wp <= zj .AND. zj < 0.5_wp        )   THEN        !  NE quadrant 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_ext_generic.h90

    r9019 r9190  
    1111 
    1212   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kextj ) 
     13      !!---------------------------------------------------------------------- 
    1314      ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied 
    1415      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_nogather_generic.h90

    r9019 r9190  
    5555 
    5656   SUBROUTINE ROUTINE_NFD( ptab, ptab2, cd_nat, psgn, kfld ) 
    57       ! 
    5857      !!---------------------------------------------------------------------- 
    5958      !! 
     
    8584      ! 
    8685      DO jf = 1, ipf                      ! Loop over the number of arrays to be processed 
     86         ! 
    8787         SELECT CASE ( npolj ) 
    8888         ! 
     
    9090            ! 
    9191            SELECT CASE ( NAT_IN(jf) ) 
    92                CASE ( 'T' , 'W' )                         ! T-, W-point 
    93                   IF ( nimpp /= 1 ) THEN   ;   startloop = 1 
    94                   ELSE                     ;   startloop = 2 
    95                ENDIF 
    96                   ! 
     92            ! 
     93            CASE ( 'T' , 'W' )                         ! T-, W-point 
     94               IF ( nimpp /= 1 ) THEN   ;   startloop = 1 
     95               ELSE                     ;   startloop = 2 
     96               ENDIF 
     97               ! 
    9798               DO ji = startloop, nlci 
    98                  ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    99                         ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf) 
    100                END DO 
    101                IF(nimpp .eq. 1) THEN 
    102                  ARRAY_IN(1,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ijpj-2,:,:,jf) 
    103                ENDIF 
    104     
     99                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     100                  ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf) 
     101               END DO 
     102               IF( nimpp == 1 ) THEN 
     103                  ARRAY_IN(1,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ijpj-2,:,:,jf) 
     104               ENDIF 
     105               ! 
    105106               IF( nimpp >= jpiglo/2+1 ) THEN 
    106107                  startloop = 1 
     
    110111                  startloop = nlci + 1 
    111112               ENDIF 
    112                IF(startloop <= nlci) THEN 
    113                DO ji = startloop, nlci 
    114                   ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    115                   jia = ji + nimpp - 1 
    116                   ijta = jpiglo - jia + 2 
    117                   IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 
    118                              ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,ijpjm1,:,:,jf) 
    119                   ELSE 
    120                              ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf) 
    121                   ENDIF 
    122                END DO 
     113               IF( startloop <= nlci ) THEN 
     114                  DO ji = startloop, nlci 
     115                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     116                     jia = ji + nimpp - 1 
     117                     ijta = jpiglo - jia + 2 
     118                     IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 
     119                        ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,ijpjm1,:,:,jf) 
     120                     ELSE 
     121                        ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf) 
     122                     ENDIF 
     123                  END DO 
    123124               ENDIF 
    124125               ! 
     
    289290               ! 
    290291            CASE ( 'I' )                                  ! ice U-V point (I-point) 
    291                   IF( nimpp /= 1 ) THEN 
    292                      startloop = 1 
    293                   ELSE 
    294                      startloop = 2 
    295                   ENDIF 
    296                   IF( nimpp + nlci - 1 /= jpiglo ) THEN 
    297                      endloop = nlci 
    298                   ELSE 
    299                      endloop = nlci - 1 
    300                   ENDIF 
    301                   DO ji = startloop , endloop 
    302                      ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    303                      ARRAY_IN(ji,ijpj,:,:,jf) = 0.5 * (ARRAY_IN(ji,ijpjm1,:,:,jf) + SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf)) 
    304                   END DO 
    305                   ! 
     292               IF( nimpp /= 1 ) THEN 
     293                  startloop = 1 
     294               ELSE 
     295                  startloop = 2 
     296               ENDIF 
     297               IF( nimpp + nlci - 1 /= jpiglo ) THEN 
     298                  endloop = nlci 
     299               ELSE 
     300                  endloop = nlci - 1 
     301               ENDIF 
     302               DO ji = startloop , endloop 
     303                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     304                  ARRAY_IN(ji,ijpj,:,:,jf) = 0.5 * (ARRAY_IN(ji,ijpjm1,:,:,jf) + SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf)) 
     305               END DO 
     306               ! 
    306307            END SELECT 
    307308            ! 
     
    310311            SELECT CASE ( NAT_IN(jf)) 
    311312            CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points 
    312                   ARRAY_IN(:, 1  ,:,:,jf) = 0._wp 
    313                   ARRAY_IN(:,ijpj,:,:,jf) = 0._wp 
     313               ARRAY_IN(:, 1  ,:,:,jf) = 0._wp 
     314               ARRAY_IN(:,ijpj,:,:,jf) = 0._wp 
    314315            CASE ( 'F' )                                   ! F-point 
    315                   ARRAY_IN(:,ijpj,:,:,jf) = 0._wp 
     316               ARRAY_IN(:,ijpj,:,:,jf) = 0._wp 
    316317            CASE ( 'I' )                                   ! ice U-V point 
    317                   ARRAY_IN(:, 1  ,:,:,jf) = 0._wp 
    318                   ARRAY_IN(:,ijpj,:,:,jf) = 0._wp 
     318               ARRAY_IN(:, 1  ,:,:,jf) = 0._wp 
     319               ARRAY_IN(:,ijpj,:,:,jf) = 0._wp 
    319320            END SELECT 
    320321            ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r9169 r9190  
    128128      INTEGER ::   iiea, ijea, iiwe, ijwe     !   -       - 
    129129      INTEGER ::   iresti, irestj, iproc      !   -       - 
    130       INTEGER, DIMENSION(jpnij) ::   iin, ii_nono, ii_noea   ! 1D workspace 
    131       INTEGER, DIMENSION(jpnij) ::   ijn, ii_noso, ii_nowe   !  -     - 
     130      REAL(wp)::   zidom, zjdom               ! local scalars 
     131      INTEGER, DIMENSION(jpnij)     ::   iin, ii_nono, ii_noea   ! 1D workspace 
     132      INTEGER, DIMENSION(jpnij)     ::   ijn, ii_noso, ii_nowe   !  -     - 
    132133      INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ilci, ibondi, ipproc   ! 2D workspace 
    133134      INTEGER, DIMENSION(jpni,jpnj) ::   ijmppt, ilcj, ibondj, ipolj    !  -     - 
     
    135136      INTEGER, DIMENSION(jpni,jpnj) ::   ilej, ildj, ioso, iowe         !  -     - 
    136137      INTEGER, DIMENSION(jpiglo,jpjglo) ::   imask   ! 2D golbal domain workspace 
    137       REAL(wp) ::   zidom, zjdom   ! local scalars 
    138138      !!---------------------------------------------------------------------- 
    139139      ! 
     
    532532      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zbot, zbdy          ! global workspace 
    533533      REAL(wp) ::   zidom , zjdom          ! local scalars 
    534       NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,         & 
     534      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,           & 
    535535           &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     & 
    536536           &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &   
    537537           &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 
    538            &             cn_ice_lim, nn_ice_lim_dta,                           & 
    539            &             rn_ice_tem, rn_ice_sal, rn_ice_age,                 & 
     538           &             cn_ice_lim, nn_ice_lim_dta,                             & 
     539           &             rn_ice_tem, rn_ice_sal, rn_ice_age,                     & 
    540540           &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy 
    541541      !!---------------------------------------------------------------------- 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90

    r9168 r9190  
    273273         WRITE(numout,*) 
    274274         SELECT CASE( nblk )              !* Print the choice of bulk algorithm 
    275          CASE( np_NCAR      )   ;   WRITE(numout,*) '      ===>>   "NCAR" algorithm        (Large and Yeager 2008)' 
    276          CASE( np_COARE_3p0 )   ;   WRITE(numout,*) '      ===>>   "COARE 3.0" algorithm   (Fairall et al. 2003)' 
    277          CASE( np_COARE_3p5 )   ;   WRITE(numout,*) '      ===>>   "COARE 3.5" algorithm   (Edson et al. 2013)' 
    278          CASE( np_ECMWF     )   ;   WRITE(numout,*) '      ===>>   "ECMWF" algorithm       (IFS cycle 31)' 
     275         CASE( np_NCAR      )   ;   WRITE(numout,*) '   ==>>>   "NCAR" algorithm        (Large and Yeager 2008)' 
     276         CASE( np_COARE_3p0 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.0" algorithm   (Fairall et al. 2003)' 
     277         CASE( np_COARE_3p5 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.5" algorithm   (Edson et al. 2013)' 
     278         CASE( np_ECMWF     )   ;   WRITE(numout,*) '   ==>>>   "ECMWF" algorithm       (IFS cycle 31)' 
    279279         END SELECT 
    280280         ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r9169 r9190  
    110110      READ  ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901) 
    111111901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp ) 
    112       ! 
    113112      REWIND( numnam_cfg )          !* Namelist namsbc in configuration namelist : Parameters of the run 
    114113      READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 
     
    188187      SELECT CASE( nn_components ) 
    189188      CASE( jp_iam_nemo ) 
    190          IF(lwp) WRITE(numout,*) '   NEMO configured as a single executable (i.e. including both OPA and Surface module' 
     189         IF(lwp) WRITE(numout,*) '   ==>>>   NEMO configured as a single executable (i.e. including both OPA and Surface module)' 
    191190      CASE( jp_iam_opa  ) 
    192          IF(lwp) WRITE(numout,*) '   Multi executable configuration. Here, OPA component' 
     191         IF(lwp) WRITE(numout,*) '   ==>>>   Multi executable configuration. Here, OPA component' 
    193192         IF( .NOT.lk_oasis )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 
    194193         IF( ln_cpl        )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA'   ) 
    195194         IF( ln_mixcpl     )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 
    196195      CASE( jp_iam_sas  ) 
    197          IF(lwp) WRITE(numout,*) '   Multi executable configuration. Here, SAS component' 
     196         IF(lwp) WRITE(numout,*) '   ==>>>   Multi executable configuration. Here, SAS component' 
    198197         IF( .NOT.lk_oasis )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 
    199198         IF( ln_mixcpl     )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 
     
    272271         WRITE(numout,*) 
    273272         SELECT CASE( nsbc ) 
    274          CASE( jp_usr     )   ;   WRITE(numout,*) '   user defined formulation' 
    275          CASE( jp_flx     )   ;   WRITE(numout,*) '      ===>>   flux formulation' 
    276          CASE( jp_blk     )   ;   WRITE(numout,*) '      ===>>   bulk formulation' 
    277          CASE( jp_purecpl )   ;   WRITE(numout,*) '      ===>>   pure coupled formulation' 
     273         CASE( jp_usr     )   ;   WRITE(numout,*) '   ==>>>   user defined forcing formulation' 
     274         CASE( jp_flx     )   ;   WRITE(numout,*) '   ==>>>   flux formulation' 
     275         CASE( jp_blk     )   ;   WRITE(numout,*) '   ==>>>   bulk formulation' 
     276         CASE( jp_purecpl )   ;   WRITE(numout,*) '   ==>>>   pure coupled formulation' 
    278277!!gm abusive use of jp_none ??   ===>>> need to be check and changed by adding a jp_sas parameter 
    279          CASE( jp_none    )   ;   WRITE(numout,*) '      ===>>   OPA coupled to SAS via oasis' 
    280             IF( ln_mixcpl )       WRITE(numout,*) '                  + forced-coupled mixed formulation' 
     278         CASE( jp_none    )   ;   WRITE(numout,*) '   ==>>>   OPA coupled to SAS via oasis' 
     279            IF( ln_mixcpl )       WRITE(numout,*) '               + forced-coupled mixed formulation' 
    281280         END SELECT 
    282          IF( ll_not_nemo  )       WRITE(numout,*) '                  + OASIS coupled SAS' 
     281         IF( ll_not_nemo  )       WRITE(numout,*) '               + OASIS coupled SAS' 
    283282      ENDIF 
    284283      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r9168 r9190  
    256256         WRITE(numout,*) 
    257257         SELECT CASE ( nadv ) 
    258          CASE( np_NO_adv  )   ;   WRITE(numout,*) '      ===>>   NO T-S advection' 
    259          CASE( np_CEN     )   ;   WRITE(numout,*) '      ===>>   CEN      scheme is used. Horizontal order: ', nn_cen_h,   & 
    260             &                                                                     ' Vertical   order: ', nn_cen_v 
    261          CASE( np_FCT     )   ;   WRITE(numout,*) '      ===>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
    262             &                                                                      ' Vertical   order: ', nn_fct_v 
    263          CASE( np_MUS     )   ;   WRITE(numout,*) '      ===>>   MUSCL    scheme is used' 
    264          CASE( np_UBS     )   ;   WRITE(numout,*) '      ===>>   UBS      scheme is used' 
    265          CASE( np_QCK     )   ;   WRITE(numout,*) '      ===>>   QUICKEST scheme is used' 
     258         CASE( np_NO_adv  )   ;   WRITE(numout,*) '   ==>>>   NO T-S advection' 
     259         CASE( np_CEN     )   ;   WRITE(numout,*) '   ==>>>   CEN      scheme is used. Horizontal order: ', nn_cen_h,   & 
     260            &                                                                        ' Vertical   order: ', nn_cen_v 
     261         CASE( np_FCT     )   ;   WRITE(numout,*) '   ==>>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
     262            &                                                                        ' Vertical   order: ', nn_fct_v 
     263         CASE( np_MUS     )   ;   WRITE(numout,*) '   ==>>>   MUSCL    scheme is used' 
     264         CASE( np_UBS     )   ;   WRITE(numout,*) '   ==>>>   UBS      scheme is used' 
     265         CASE( np_QCK     )   ;   WRITE(numout,*) '   ==>>>   QUICKEST scheme is used' 
    266266         END SELECT 
    267267      ENDIF 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    r9168 r9190  
    292292         WRITE(numout,*) 
    293293         IF( ln_mle ) THEN 
    294             WRITE(numout,*) '      ===>>   Mixed Layer Eddy induced transport added to tracer advection' 
     294            WRITE(numout,*) '   ==>>>   Mixed Layer Eddy induced transport added to tracer advection' 
    295295            IF( nn_mle == 0 )   WRITE(numout,*) '              Fox-Kemper et al 2010 formulation' 
    296296            IF( nn_mle == 1 )   WRITE(numout,*) '              New formulation' 
    297297         ELSE 
    298             WRITE(numout,*) '      ===>>   Mixed Layer Eddy parametrisation NOT used' 
     298            WRITE(numout,*) '   ==>>>   Mixed Layer Eddy parametrisation NOT used' 
    299299         ENDIF 
    300300      ENDIF 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r9168 r9190  
    160160         ! 
    161161         CASE ( 1 )                          !* constant flux 
    162             IF(lwp) WRITE(numout,*) '      ===>>   constant heat flux  =   ', rn_geoflx_cst 
     162            IF(lwp) WRITE(numout,*) '   ==>>>   constant heat flux  =   ', rn_geoflx_cst 
    163163            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst 
    164164            ! 
    165165         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 
    166             IF(lwp) WRITE(numout,*) '      ===>>   variable geothermal heat flux' 
     166            IF(lwp) WRITE(numout,*) '   ==>>>   variable geothermal heat flux' 
    167167            ! 
    168168            ALLOCATE( sf_qgh(1), STAT=ierror ) 
     
    186186         ! 
    187187      ELSE 
    188          IF(lwp) WRITE(numout,*) '      ===>>   no geothermal heat flux' 
     188         IF(lwp) WRITE(numout,*) '   ==>>>   no geothermal heat flux' 
    189189      ENDIF 
    190190      ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r9019 r9190  
    185185         WRITE(numout,*) 
    186186         SELECT CASE( nldf ) 
    187          CASE( np_no_ldf )   ;   WRITE(numout,*) '      ===>>   NO lateral diffusion' 
    188          CASE( np_lap    )   ;   WRITE(numout,*) '      ===>>   laplacian iso-level operator' 
    189          CASE( np_lap_i  )   ;   WRITE(numout,*) '      ===>>   Rotated laplacian operator (standard)' 
    190          CASE( np_lap_it )   ;   WRITE(numout,*) '      ===>>   Rotated laplacian operator (triad)' 
    191          CASE( np_blp    )   ;   WRITE(numout,*) '      ===>>   bilaplacian iso-level operator' 
    192          CASE( np_blp_i  )   ;   WRITE(numout,*) '      ===>>   Rotated bilaplacian operator (standard)' 
    193          CASE( np_blp_it )   ;   WRITE(numout,*) '      ===>>   Rotated bilaplacian operator (triad)' 
     187         CASE( np_no_ldf )   ;   WRITE(numout,*) '   ==>>>   NO lateral diffusion' 
     188         CASE( np_lap    )   ;   WRITE(numout,*) '   ==>>>   laplacian iso-level operator' 
     189         CASE( np_lap_i  )   ;   WRITE(numout,*) '   ==>>>   Rotated laplacian operator (standard)' 
     190         CASE( np_lap_it )   ;   WRITE(numout,*) '   ==>>>   Rotated laplacian operator (triad)' 
     191         CASE( np_blp    )   ;   WRITE(numout,*) '   ==>>>   bilaplacian iso-level operator' 
     192         CASE( np_blp_i  )   ;   WRITE(numout,*) '   ==>>>   Rotated bilaplacian operator (standard)' 
     193         CASE( np_blp_it )   ;   WRITE(numout,*) '   ==>>>   Rotated bilaplacian operator (triad)' 
    194194         END SELECT 
    195195      ENDIF 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfdrg.F90

    r9168 r9190  
    289289      IF( ln_boost ) THEN           !* regional boost:   boost factor = 1 + regional boost 
    290290         IF(lwp) WRITE(numout,*) 
    291          IF(lwp) WRITE(numout,*) '   ==>>   use a regional boost read in ', TRIM(cl_file), ' file' 
    292          IF(lwp) WRITE(numout,*) '          using enhancement factor of ', rn_boost 
     291         IF(lwp) WRITE(numout,*) '   ==>>>   use a regional boost read in ', TRIM(cl_file), ' file' 
     292         IF(lwp) WRITE(numout,*) '           using enhancement factor of ', rn_boost 
    293293         ! cl_varname is a coefficient in [0,1] giving where to apply the regional boost 
    294294         CALL iom_open ( TRIM(cl_file), inum ) 
     
    309309      CASE( np_NONE )            !==  No top/bottom friction  ==!   (pCdU = 0) 
    310310         IF(lwp) WRITE(numout,*) 
    311          IF(lwp) WRITE(numout,*) '   ==>>   ',TRIM(cd_topbot),' free-slip, friction set to zero' 
     311         IF(lwp) WRITE(numout,*) '   ==>>>   ',TRIM(cd_topbot),' free-slip, friction set to zero' 
    312312         ! 
    313313         l_zdfdrg = .FALSE.         ! no time variation of the drag: set it one for all 
     
    318318      CASE( np_lin )             !==  linear friction  ==!   (pCdU = Cd0 * Uc0) 
    319319         IF(lwp) WRITE(numout,*) 
    320          IF(lwp) WRITE(numout,*) '   ==>>   linear ',TRIM(cd_topbot),' friction (constant coef = Cd0*Uc0 = ', rn_Cd0*rn_Uc0, ')' 
     320         IF(lwp) WRITE(numout,*) '   ==>>>   linear ',TRIM(cd_topbot),' friction (constant coef = Cd0*Uc0 = ', rn_Cd0*rn_Uc0, ')' 
    321321         ! 
    322322         l_zdfdrg = .FALSE.         ! no time variation of the Cd*|U| : set it one for all 
     
    327327      CASE( np_non_lin )         !== non-linear friction  ==!   (pCd0 = Cd0 ) 
    328328         IF(lwp) WRITE(numout,*) 
    329          IF(lwp) WRITE(numout,*) '   ==>>   quadratic ',TRIM(cd_topbot),' friction (propotional to module of the velocity)' 
    330          IF(lwp) WRITE(numout,*) '   with   Cd0 = ', rn_Cd0, ', and',   & 
    331             &                             ' a background velocity module of (rn_ke0)^1/2 = ', SQRT(rn_ke0), 'm/s)' 
     329         IF(lwp) WRITE(numout,*) '   ==>>>   quadratic ',TRIM(cd_topbot),' friction (propotional to module of the velocity)' 
     330         IF(lwp) WRITE(numout,*) '   with    a drag coefficient Cd0 = ', rn_Cd0, ', and' 
     331         IF(lwp) WRITE(numout,*) '          a background velocity module of (rn_ke0)^1/2 = ', SQRT(rn_ke0), 'm/s)' 
    332332         ! 
    333333         l_zdfdrg = .TRUE.          !* Cd*|U| updated at each time-step (it depends on ocean velocity) 
     
    338338      CASE( np_loglayer )       !== logarithmic layer formulation of friction  ==!   (CdU = (vkarman log(z/z0))^2 |U| ) 
    339339         IF(lwp) WRITE(numout,*) 
    340          IF(lwp) WRITE(numout,*) '   ==>>   quadratic ',TRIM(cd_topbot),' drag (propotional to module of the velocity)' 
     340         IF(lwp) WRITE(numout,*) '   ==>>>   quadratic ',TRIM(cd_topbot),' drag (propotional to module of the velocity)' 
    341341         IF(lwp) WRITE(numout,*) '   with   a logarithmic Cd0 formulation Cd0 = ( vkarman log(z/z0) )^2 ,' 
    342342         IF(lwp) WRITE(numout,*) '          a background velocity module of (rn_ke0)^1/2 = ', SQRT(pke0), 'm/s), ' 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfosm.F90

    r9119 r9190  
    164164 
    165165      REAL(wp) ::   ztx, zty, zflageos, zstabl, zbuofdep,zucube      ! 
    166       REAL(wp) ::   zalbet, zbeta, zthermal, zatt1                   ! 
     166      REAL(wp) ::   zbeta, zthermal                                  ! 
    167167      REAL(wp) ::   zehat, zeta, zhrib, zsig, zscale, zwst, zws, zwm ! Velocity scales 
    168168      REAL(wp) ::   zwsun, zwmun, zcons, zconm, zwcons, zwconm       ! 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r9169 r9190  
    298298                  !                                           ! TKE Langmuir circulation source term 
    299299                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc )   & 
    300                      &                              / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     300                     &                              / zhlc(ji,jj) * wmask(ji,jj,jk) 
     301!!gm                     &                          / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    301302               END DO 
    302303            END DO 
     
    400401               DO ji = fs_2, fs_jpim1   ! vector opt. 
    401402                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    402                      &                                 * MAX(0.,1._wp - 4.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     403                     &                                 * MAX(0.,1._wp - 4.*fr_i(ji,jj) )  * wmask(ji,jj,jk) 
     404!!gm                     &                             * MAX(0.,1._wp - 4.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     405!!gm    multiplication by surface tmask useless (already includes in MAX( 0, 1-4*fr_i ) 
    403406               END DO 
    404407            END DO 
     
    409412               jk = nmln(ji,jj) 
    410413               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    411                   &                                 * MAX(0.,1._wp - 4.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     414                  &                                 * MAX(0.,1._wp - 4.*fr_i(ji,jj) )  * wmask(ji,jj,jk) 
     415!!gm                  &                             * MAX(0.,1._wp - 4.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    412416            END DO 
    413417         END DO 
     
    422426                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
    423427                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    424                      &                        * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     428                     &                        * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * wmask(ji,jj,jk) 
     429!!gm                     &                    * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    425430               END DO 
    426431            END DO 
     
    685690         ENDIF 
    686691         WRITE(numout,*) 
    687          WRITE(numout,*) '   ==>>   critical Richardson nb with your parameters  ri_cri = ', ri_cri 
     692         WRITE(numout,*) '   ==>>>   critical Richardson nb with your parameters  ri_cri = ', ri_cri 
    688693         WRITE(numout,*) 
    689694      ENDIF 
     
    692697         rn_emin  = 1.e-10_wp             ! specific values of rn_emin & rmxl_min are used 
    693698         rmxl_min = 1.e-03_wp             ! associated avt minimum = molecular salt diffusivity (10^-9 m2/s) 
    694          IF(lwp) WRITE(numout,*) '   ==>>   Internal wave-driven mixing case:   force   rn_emin = 1.e-10 and rmxl_min = 1.e-3' 
     699         IF(lwp) WRITE(numout,*) '   ==>>>   Internal wave-driven mixing case:   force   rn_emin = 1.e-10 and rmxl_min = 1.e-3' 
    695700      ELSE                          ! standard case : associated avt minimum = molecular viscosity (10^-6 m2/s) 
    696701         rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) )    ! resulting minimum length to recover molecular viscosity 
    697          IF(lwp) WRITE(numout,*) '   ==>>   minimum mixing length with your parameters rmxl_min = ', rmxl_min 
     702         IF(lwp) WRITE(numout,*) '   ==>>>   minimum mixing length with your parameters rmxl_min = ', rmxl_min 
    698703      ENDIF 
    699704      ! 
     
    709714      IF( ln_mxl0 ) THEN 
    710715         IF(lwp) WRITE(numout,*) 
    711          IF(lwp) WRITE(numout,*) '   ==>>   use a surface mixing length = F(stress) :   set rn_mxl0 = rmxl_min' 
     716         IF(lwp) WRITE(numout,*) '   ==>>>   use a surface mixing length = F(stress) :   set rn_mxl0 = rmxl_min' 
    712717         rn_mxl0 = rmxl_min 
    713718      ENDIF 
     
    764769            ELSE                                          ! start TKE from rest 
    765770               IF(lwp) WRITE(numout,*) 
    766                IF(lwp) WRITE(numout,*) '   ==>>   previous run without TKE scheme, set en to background values' 
     771               IF(lwp) WRITE(numout,*) '   ==>>>   previous run without TKE scheme, set en to background values' 
    767772               en   (:,:,:) = rn_emin * wmask(:,:,:) 
    768773               dissl(:,:,:) = 1.e-12_wp 
     
    771776         ELSE                                   !* Start from rest 
    772777            IF(lwp) WRITE(numout,*) 
    773             IF(lwp) WRITE(numout,*) '   ==>>   start from rest: set en to the background value' 
     778            IF(lwp) WRITE(numout,*) '   ==>>>   start from rest: set en to the background value' 
    774779            en   (:,:,:) = rn_emin * wmask(:,:,:) 
    775780            dissl(:,:,:) = 1.e-12_wp 
Note: See TracChangeset for help on using the changeset viewer.