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

Changeset 7163


Ignore:
Timestamp:
2016-11-01T15:26:15+01:00 (8 years ago)
Author:
gm
Message:

#1751 - branch SIMPLIF_6_aerobulk: update option control in sbcmod + uniformization of print in ocean_output (many module involved)

Location:
branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM
Files:
41 edited

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/CONFIG/SHARED/namelist_ref

    r6723 r7163  
    270270   nn_ice      = 2         !  =0 no ice boundary condition   , 
    271271                           !  =1 use observed ice-cover      , 
    272                            !  =2 ice-model used                         ("key_lim3", "key_lim2", or "key_cice") 
     272                           !  =2 to 4 :  ice-model used (LIM2, LIM3 or CICE)                         ("key_lim3", "key_lim2", or "key_cice") 
    273273   nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
    274274                           !  =1 levitating ice with mass and salt exchange but no presure effect 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r6723 r7163  
    110110 
    111111      IF(lwp) WRITE(numout,*) 
    112       IF(lwp) WRITE(numout,*) 'lim_istate: sea-ice initialization ' 
     112      IF(lwp) WRITE(numout,*) 'lim_istate : sea-ice initialization ' 
    113113      IF(lwp) WRITE(numout,*) '~~~~~~~~~~ ' 
    114114 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r6470 r7163  
    969969      IF (lwp) THEN                          ! control print 
    970970         WRITE(numout,*) 
    971          WRITE(numout,*)' lim_itd_me_init : ice parameters for mechanical ice redistribution ' 
    972          WRITE(numout,*)' ~~~~~~~~~~~~~~~' 
    973          WRITE(numout,*)'   Fraction of shear energy contributing to ridging        rn_cs       = ', rn_cs  
    974          WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrdg = ', rn_fsnowrdg  
    975          WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrft = ', rn_fsnowrft  
    976          WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  rn_gstar    = ', rn_gstar 
    977          WRITE(numout,*)'   Equivalent to G* for an exponential part function       rn_astar    = ', rn_astar 
    978          WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     rn_hstar    = ', rn_hstar 
    979          WRITE(numout,*)'   Rafting of ice sheets or not                            ln_rafting  = ', ln_rafting 
    980          WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       rn_hraft    = ', rn_hraft 
    981          WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  rn_craft    = ', rn_craft   
    982          WRITE(numout,*)'   Initial porosity of ridges                              rn_por_rdg  = ', rn_por_rdg 
    983          WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    nn_partfun  = ', nn_partfun 
     971         WRITE(numout,*) ' lim_itd_me_init : ice parameters for mechanical ice redistribution ' 
     972         WRITE(numout,*) ' ~~~~~~~~~~~~~~~' 
     973         WRITE(numout,*) '   Namelist namiceitdme :' 
     974         WRITE(numout,*) '      Fraction of shear energy contributing to ridging        rn_cs       = ', rn_cs  
     975         WRITE(numout,*) '      Fraction of snow volume conserved during ridging        rn_fsnowrdg = ', rn_fsnowrdg  
     976         WRITE(numout,*) '      Fraction of snow volume conserved during ridging        rn_fsnowrft = ', rn_fsnowrft  
     977         WRITE(numout,*) '      Fraction of total ice coverage contributing to ridging  rn_gstar    = ', rn_gstar 
     978         WRITE(numout,*) '      Equivalent to G* for an exponential part function       rn_astar    = ', rn_astar 
     979         WRITE(numout,*) '      Quantity playing a role in max ridged ice thickness     rn_hstar    = ', rn_hstar 
     980         WRITE(numout,*) '      Rafting of ice sheets or not                            ln_rafting  = ', ln_rafting 
     981         WRITE(numout,*) '      Parmeter thickness (threshold between ridge-raft)       rn_hraft    = ', rn_hraft 
     982         WRITE(numout,*) '      Rafting hyperbolic tangent coefficient                  rn_craft    = ', rn_craft   
     983         WRITE(numout,*) '      Initial porosity of ridges                              rn_por_rdg  = ', rn_por_rdg 
     984         WRITE(numout,*) '      Switch for part. function (0) linear (1) exponential    nn_partfun  = ', nn_partfun 
    984985      ENDIF 
    985986      ! 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r6416 r7163  
    621621      IF(lwp) THEN 
    622622         WRITE(numout,*) 
    623          WRITE(numout,*) 'lim_thd : Ice Thermodynamics' 
    624          WRITE(numout,*) '~~~~~~~' 
     623         WRITE(numout,*) 'lim_thd_init : Ice Thermodynamics initialization' 
     624         WRITE(numout,*) '~~~~~~~~~~~~' 
    625625      ENDIF 
    626626      ! 
    … …  
    634634      IF(lwm) WRITE ( numoni, namicethd ) 
    635635      ! 
    636       IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN  
    637          nn_monocat = 0 
    638          IF(lwp) WRITE(numout, *) '   nn_monocat must be 0 in multi-category case ' 
    639       ENDIF 
    640  
    641       ! 
    642636      IF(lwp) THEN                          ! control print 
    643          WRITE(numout,*) 
    644637         WRITE(numout,*)'   Namelist of ice parameters for ice thermodynamic computation ' 
    645638         WRITE(numout,*)'      ice thick. for lateral accretion                        rn_hnewice   = ', rn_hnewice 
    … …  
    659652         WRITE(numout,*)'      iterate the surface non-solar flux (T) or not (F)       ln_it_qnsice = ', ln_it_qnsice 
    660653      ENDIF 
     654      IF( jpl > 1 .AND. nn_monocat == 1 ) THEN  
     655         nn_monocat = 0 
     656         IF(lwp) WRITE(numout,*) 
     657         IF(lwp) WRITE(numout,*) '   nn_monocat forced to 0 as jpl>1, i.e. multi-category case is chosen' 
     658      ENDIF 
    661659      ! 
    662660   END SUBROUTINE lim_thd_init 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

    r6470 r7163  
    144144         WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity ' 
    145145         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    146          WRITE(numout,*) '   switch for salinity nn_icesal        = ', nn_icesal 
    147          WRITE(numout,*) '   bulk salinity value if nn_icesal = 1 = ', rn_icesal 
    148          WRITE(numout,*) '   restoring salinity for GD            = ', rn_sal_gd 
    149          WRITE(numout,*) '   restoring time for GD                = ', rn_time_gd 
    150          WRITE(numout,*) '   restoring salinity for flushing      = ', rn_sal_fl 
    151          WRITE(numout,*) '   restoring time for flushing          = ', rn_time_fl 
    152          WRITE(numout,*) '   Maximum tolerated ice salinity       = ', rn_simax 
    153          WRITE(numout,*) '   Minimum tolerated ice salinity       = ', rn_simin 
     146         WRITE(numout,*) '   Namelist namicesal :' 
     147         WRITE(numout,*) '      switch for salinity nn_icesal        = ', nn_icesal 
     148         WRITE(numout,*) '      bulk salinity value if nn_icesal = 1 = ', rn_icesal 
     149         WRITE(numout,*) '      restoring salinity for GD            = ', rn_sal_gd 
     150         WRITE(numout,*) '      restoring time for GD                = ', rn_time_gd 
     151         WRITE(numout,*) '      restoring salinity for flushing      = ', rn_sal_fl 
     152         WRITE(numout,*) '      restoring time for flushing          = ', rn_time_fl 
     153         WRITE(numout,*) '      Maximum tolerated ice salinity       = ', rn_simax 
     154         WRITE(numout,*) '      Minimum tolerated ice salinity       = ', rn_simin 
    154155      ENDIF 
    155156      ! 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r6140 r7163  
    230230 
    231231   SUBROUTINE dia_hsb_rst( kt, cdrw ) 
    232      !!--------------------------------------------------------------------- 
    233      !!                   ***  ROUTINE limdia_rst  *** 
    234      !!                      
    235      !! ** Purpose :   Read or write DIA file in restart file 
    236      !! 
    237      !! ** Method  :   use of IOM library 
    238      !!---------------------------------------------------------------------- 
    239      INTEGER         , INTENT(in) ::   kt     ! ocean time-step 
    240      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    241      ! 
    242      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    243      INTEGER ::   id1          ! local integers 
    244      !!---------------------------------------------------------------------- 
    245      ! 
    246      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
    247         IF( ln_rstart ) THEN                   !* Read the restart file 
    248            !id1 = iom_varid( numror, 'frc_vol'  , ldstop = .FALSE. ) 
    249            ! 
    250            IF(lwp) WRITE(numout,*) '~~~~~~~' 
    251            IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 
    252            IF(lwp) WRITE(numout,*) '~~~~~~~' 
    253            CALL iom_get( numror, 'frc_v', frc_v ) 
    254            CALL iom_get( numror, 'frc_t', frc_t ) 
    255            CALL iom_get( numror, 'frc_s', frc_s ) 
    256            IF( ln_linssh ) THEN 
    257               CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 
    258               CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 
    259            ENDIF 
    260            CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 
    261            CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini ) 
    262            CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini ) 
    263            CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini ) 
    264            CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini ) 
    265            IF( ln_linssh ) THEN 
    266               CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 
    267               CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 
    268            ENDIF 
    269        ELSE 
    270           IF(lwp) WRITE(numout,*) '~~~~~~~' 
    271           IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 
    272           IF(lwp) WRITE(numout,*) '~~~~~~~' 
    273           surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface 
    274           ssh_ini(:,:) = sshn(:,:)                          ! initial ssh 
    275           DO jk = 1, jpk 
    276              ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 
    277              e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors 
    278              hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content 
    279              sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content 
    280           END DO 
    281           frc_v = 0._wp                                           ! volume       trend due to forcing 
    282           frc_t = 0._wp                                           ! heat content   -    -   -    -    
    283           frc_s = 0._wp                                           ! salt content   -    -   -    -         
    284           IF( ln_linssh ) THEN 
    285              IF ( ln_isfcav ) THEN 
    286                 DO ji=1,jpi 
    287                    DO jj=1,jpj 
    288                       ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj)   ! initial heat content in ssh 
    289                       ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj)   ! initial salt content in ssh 
    290                    ENDDO 
    291                 ENDDO 
    292              ELSE 
    293                 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh 
    294                 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh 
    295              END IF 
    296              frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface 
    297              frc_wn_s = 0._wp                                       ! initial salt content misfit due to free surface 
    298           ENDIF 
    299        ENDIF 
    300  
    301      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
    302         !                                   ! ------------------- 
    303         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    304         IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 
    305         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    306  
    307         CALL iom_rstput( kt, nitrst, numrow, 'frc_v'   , frc_v     ) 
    308         CALL iom_rstput( kt, nitrst, numrow, 'frc_t'   , frc_t     ) 
    309         CALL iom_rstput( kt, nitrst, numrow, 'frc_s'   , frc_s     ) 
    310         IF( ln_linssh ) THEN 
    311            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 
    312            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 
    313         ENDIF 
    314         CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini )      ! ice sheet coupling 
    315         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini ) 
    316         CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini ) 
    317         CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini ) 
    318         CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini ) 
    319         IF( ln_linssh ) THEN 
    320            CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 
    321            CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 
    322         ENDIF 
    323         ! 
    324      ENDIF 
    325      ! 
     232      !!--------------------------------------------------------------------- 
     233      !!                   ***  ROUTINE limdia_rst  *** 
     234      !!                      
     235      !! ** Purpose :   Read or write DIA file in restart file 
     236      !!  
     237      !! ** Method  :   use of IOM library 
     238      !!---------------------------------------------------------------------- 
     239      INTEGER         , INTENT(in) ::   kt     ! ocean time-step 
     240      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
     241      ! 
     242      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     243      INTEGER ::   id1          ! local integers 
     244      !!---------------------------------------------------------------------- 
     245      ! 
     246      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
     247         IF( ln_rstart ) THEN                   !* Read the restart file 
     248            !id1 = iom_varid( numror, 'frc_vol'  , ldstop = .FALSE. ) 
     249            ! 
     250            IF(lwp) WRITE(numout,*) 
     251            IF(lwp) WRITE(numout,*) '   dia_hsb_rst : read restart at it= ', kt,' date= ', ndastp 
     252            IF(lwp) WRITE(numout,*) '   ~~~~~~~~~~~' 
     253            CALL iom_get( numror, 'frc_v', frc_v ) 
     254            CALL iom_get( numror, 'frc_t', frc_t ) 
     255            CALL iom_get( numror, 'frc_s', frc_s ) 
     256            IF( ln_linssh ) THEN 
     257               CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 
     258               CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 
     259            ENDIF 
     260            CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 
     261            CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini ) 
     262            CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini ) 
     263            CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini ) 
     264            CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini ) 
     265            IF( ln_linssh ) THEN 
     266               CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 
     267               CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 
     268            ENDIF 
     269         ELSE 
     270            IF(lwp) WRITE(numout,*) 
     271            IF(lwp) WRITE(numout,*) '   dia_hsb_rst : no restart, set value at initial state ' 
     272            IF(lwp) WRITE(numout,*) '   ~~~~~~~~~~~' 
     273            surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface 
     274            ssh_ini(:,:) = sshn(:,:)                          ! initial ssh 
     275            DO jk = 1, jpk 
     276               ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 
     277               e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors 
     278               hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content 
     279               sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content 
     280            END DO 
     281            frc_v = 0._wp                                           ! volume       trend due to forcing 
     282            frc_t = 0._wp                                           ! heat content   -    -   -    -    
     283            frc_s = 0._wp                                           ! salt content   -    -   -    -         
     284            IF( ln_linssh ) THEN 
     285               IF( ln_isfcav ) THEN 
     286                  DO ji=1,jpi 
     287                     DO jj=1,jpj 
     288                        ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj)   ! initial heat content in ssh 
     289                        ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj)   ! initial salt content in ssh 
     290                     END DO 
     291                  END DO 
     292               ELSE 
     293                  ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh 
     294                  ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh 
     295               END IF 
     296               frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface 
     297               frc_wn_s = 0._wp                                       ! initial salt content misfit due to free surface 
     298            ENDIF 
     299         ENDIF 
     300         ! 
     301      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
     302         !                                   ! ------------------- 
     303         IF(lwp) WRITE(numout,*) 
     304         IF(lwp) WRITE(numout,*) '   dia_hsb_rst : write restart at it= ', kt,' date= ', ndastp 
     305         IF(lwp) WRITE(numout,*) '   ~~~~~~~~~~~' 
     306 
     307         CALL iom_rstput( kt, nitrst, numrow, 'frc_v'   , frc_v     ) 
     308         CALL iom_rstput( kt, nitrst, numrow, 'frc_t'   , frc_t     ) 
     309         CALL iom_rstput( kt, nitrst, numrow, 'frc_s'   , frc_s     ) 
     310         IF( ln_linssh ) THEN 
     311            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 
     312            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 
     313         ENDIF 
     314         CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini )      ! ice sheet coupling 
     315         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini ) 
     316         CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini ) 
     317         CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini ) 
     318         CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini ) 
     319         IF( ln_linssh ) THEN 
     320            CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 
     321            CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 
     322         ENDIF 
     323         ! 
     324      ENDIF 
     325      ! 
    326326   END SUBROUTINE dia_hsb_rst 
    327327 
    … …  
    342342      INTEGER ::   ierror   ! local integer 
    343343      INTEGER ::   ios 
    344       ! 
     344      !! 
    345345      NAMELIST/namhsb/ ln_diahsb 
    346346      !!---------------------------------------------------------------------- 
    347  
    348       IF(lwp) THEN 
    349          WRITE(numout,*) 
    350          WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 
    351          WRITE(numout,*) '~~~~~~~~ ' 
    352       ENDIF 
    353  
     347      ! 
    354348      REWIND( numnam_ref )              ! Namelist namhsb in reference namelist 
    355349      READ  ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) 
    … …  
    368362         WRITE(numout,*) '   Namelist namhsb : set hsb parameters' 
    369363         WRITE(numout,*) '      Switch for hsb diagnostic (T) or not (F)  ln_diahsb  = ', ln_diahsb 
    370          WRITE(numout,*) 
    371364      ENDIF 
    372365 
    373366      IF( .NOT. ln_diahsb )   RETURN 
    374          !      IF( .NOT. lk_mpp_rep ) & 
    375          !        CALL ctl_stop (' Your global mpp_sum if performed in single precision - 64 bits -', & 
    376          !             &         ' whereas the global sum to be precise must be done in double precision ',& 
    377          !             &         ' please add key_mpp_rep') 
    378367 
    379368      ! ------------------- ! 
    … …  
    383372         &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), STAT=ierror  ) 
    384373      IF( ierror > 0 ) THEN 
    385          CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
     374         CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' )   ;   RETURN 
    386375      ENDIF 
    387376 
    388377      IF( ln_linssh )   ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 
    389378      IF( ierror > 0 ) THEN 
    390          CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
     379         CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' )   ;   RETURN 
    391380      ENDIF 
    392381 
    … …  
    394383      ! 2 - Time independant variables and file opening ! 
    395384      ! ----------------------------------------------- ! 
    396       IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 
    397       IF(lwp) WRITE(numout,*) '~~~~~~~' 
     385      IF(lwp) WRITE(numout,*) 
     386      IF(lwp) WRITE(numout,*) "   heat salt volume budgets activated" 
    398387      surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)      ! masked surface grid cell area 
    399388      surf_tot  = glob_sum( surf(:,:) )                                       ! total ocean surface area 
    400389 
    401       IF( lk_bdy ) CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )          
     390      IF( lk_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' )          
    402391      ! 
    403392      ! ---------------------------------- ! 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r6140 r7163  
    5353      LOGICAL, INTENT(in), OPTIONAL ::   ld_tradmp   ! force the initialization when tradp is used 
    5454      ! 
    55       INTEGER ::   ierr0, ierr1, ierr2, ierr3   ! temporary integers 
    56       ! 
     55      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3   ! local integers 
     56      !! 
    5757      CHARACTER(len=100)            ::   cn_dir          ! Root directory for location of ssr files 
    5858      TYPE(FLD_N), DIMENSION( jpts) ::   slf_i           ! array of namelist informations on the fields to read 
    … …  
    6060      !! 
    6161      NAMELIST/namtsd/   ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal 
    62       INTEGER  ::   ios 
    6362      !!---------------------------------------------------------------------- 
    6463      ! 
    … …  
    117116         !                         ! fill sf_tsd with sn_tem & sn_sal and control print 
    118117         slf_i(jp_tem) = sn_tem   ;   slf_i(jp_sal) = sn_sal 
    119          CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd' ) 
     118         CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd', no_print ) 
    120119         ! 
    121120      ENDIF 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r5147 r7163  
    106106 
    107107      IF(lwp) WRITE(numout,*) 
    108       IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 
    109       IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     108      IF(lwp) WRITE(numout,*) 'phy_cst : initialization of ocean parameters and constants' 
     109      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    110110 
    111111      ! Ocean Parameters 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90

    r6140 r7163  
    106106         WRITE(numout,*) 
    107107         WRITE(numout,*) 'dyn_adv_init : choice/control of the momentum advection scheme' 
    108          WRITE(numout,*) '~~~~~~~~~~~' 
    109          WRITE(numout,*) '       Namelist namdyn_adv : chose a advection formulation & scheme for momentum' 
    110          WRITE(numout,*) '          Vector/flux form (T/F)                           ln_dynadv_vec  = ', ln_dynadv_vec 
    111          WRITE(numout,*) '          = 0 standard scheme  ; =1 Hollingsworth scheme   nn_dynkeg      = ', nn_dynkeg 
    112          WRITE(numout,*) '          2nd order centred advection scheme               ln_dynadv_cen2 = ', ln_dynadv_cen2 
    113          WRITE(numout,*) '          3rd order UBS advection scheme                   ln_dynadv_ubs  = ', ln_dynadv_ubs 
    114          WRITE(numout,*) '          Sub timestepping of vertical advection           ln_dynzad_zts  = ', ln_dynzad_zts 
     108         WRITE(numout,*) '~~~~~~~~~~~~' 
     109         WRITE(numout,*) '   Namelist namdyn_adv : chose a advection formulation & scheme for momentum' 
     110         WRITE(numout,*) '      Vector/flux form (T/F)                           ln_dynadv_vec  = ', ln_dynadv_vec 
     111         WRITE(numout,*) '      = 0 standard scheme  ; =1 Hollingsworth scheme   nn_dynkeg      = ', nn_dynkeg 
     112         WRITE(numout,*) '      2nd order centred advection scheme               ln_dynadv_cen2 = ', ln_dynadv_cen2 
     113         WRITE(numout,*) '      3rd order UBS advection scheme                   ln_dynadv_ubs  = ', ln_dynadv_ubs 
     114         WRITE(numout,*) '      Sub timestepping of vertical advection           ln_dynzad_zts  = ', ln_dynzad_zts 
    115115      ENDIF 
    116116 
    … …  
    134134      IF(lwp) THEN                    ! Print the choice 
    135135         WRITE(numout,*) 
    136          IF( nadv ==  0 )   WRITE(numout,*) '         vector form : keg + zad + vor is used'  
    137          IF( nadv ==  1 )   WRITE(numout,*) '         vector form : keg + zad_zts + vor is used' 
     136         IF( nadv ==  0 )   WRITE(numout,*) '      ===>>   vector form : keg + zad + vor is used'  
     137         IF( nadv ==  1 )   WRITE(numout,*) '      ===>>   vector form : keg + zad_zts + vor is used' 
    138138         IF( nadv ==  0 .OR. nadv ==  1 ) THEN 
    139             IF( nn_dynkeg == nkeg_C2  )   WRITE(numout,*) 'with Centered standard keg scheme' 
    140             IF( nn_dynkeg == nkeg_HW  )   WRITE(numout,*) 'with Hollingsworth keg scheme' 
     139            IF( nn_dynkeg == nkeg_C2  )   WRITE(numout,*) '              with Centered standard keg scheme' 
     140            IF( nn_dynkeg == nkeg_HW  )   WRITE(numout,*) '              with Hollingsworth keg scheme' 
    141141         ENDIF 
    142          IF( nadv ==  2 )   WRITE(numout,*) '         flux form   : 2nd order scheme is used' 
    143          IF( nadv ==  3 )   WRITE(numout,*) '         flux form   : UBS       scheme is used' 
     142         IF( nadv ==  2 )   WRITE(numout,*) '      ===>>   flux form   : 2nd order scheme is used' 
     143         IF( nadv ==  3 )   WRITE(numout,*) '      ===>>   flux form   : UBS       scheme is used' 
    144144      ENDIF 
    145145      ! 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r6140 r7163  
    110110         WRITE(numout,*) 
    111111         WRITE(numout,*) 'dyn_ldf_init : Choice of the lateral diffusive operator on dynamics' 
    112          WRITE(numout,*) '~~~~~~~~~~~' 
    113          WRITE(numout,*) '       Namelist nam_dynldf : set lateral mixing parameters (type, direction, coefficients)' 
    114          WRITE(numout,*) '          laplacian operator          ln_dynldf_lap = ', ln_dynldf_lap 
    115          WRITE(numout,*) '          bilaplacian operator        ln_dynldf_blp = ', ln_dynldf_blp 
    116          WRITE(numout,*) '          iso-level                   ln_dynldf_lev = ', ln_dynldf_lev 
    117          WRITE(numout,*) '          horizontal (geopotential)   ln_dynldf_hor = ', ln_dynldf_hor 
    118          WRITE(numout,*) '          iso-neutral                 ln_dynldf_iso = ', ln_dynldf_iso 
     112         WRITE(numout,*) '~~~~~~~~~~~~' 
     113         WRITE(numout,*) '   Namelist nam_dynldf : set lateral mixing parameters (type, direction, coefficients)' 
     114         WRITE(numout,*) '      laplacian operator          ln_dynldf_lap = ', ln_dynldf_lap 
     115         WRITE(numout,*) '      bilaplacian operator        ln_dynldf_blp = ', ln_dynldf_blp 
     116         WRITE(numout,*) '      iso-level                   ln_dynldf_lev = ', ln_dynldf_lev 
     117         WRITE(numout,*) '      horizontal (geopotential)   ln_dynldf_hor = ', ln_dynldf_hor 
     118         WRITE(numout,*) '      iso-neutral                 ln_dynldf_iso = ', ln_dynldf_iso 
    119119      ENDIF 
    120120      !                                   ! use of lateral operator or not 
    … …  
    180180      IF(lwp) THEN 
    181181         WRITE(numout,*) 
    182          IF( nldf == np_no_ldf )   WRITE(numout,*) '              NO lateral viscosity' 
    183          IF( nldf == np_lap    )   WRITE(numout,*) '              iso-level laplacian operator' 
    184          IF( nldf == np_lap_i  )   WRITE(numout,*) '              rotated laplacian operator with iso-level background' 
    185          IF( nldf == np_blp    )   WRITE(numout,*) '              iso-level bi-laplacian operator' 
     182         IF( nldf == np_no_ldf )   WRITE(numout,*) '      ===>>   NO lateral viscosity' 
     183         IF( nldf == np_lap    )   WRITE(numout,*) '      ===>>   iso-level laplacian operator' 
     184         IF( nldf == np_lap_i  )   WRITE(numout,*) '      ===>>   rotated laplacian operator with iso-level background' 
     185         IF( nldf == np_blp    )   WRITE(numout,*) '      ===>>   iso-level bi-laplacian operator' 
    186186      ENDIF 
    187187      ! 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r6140 r7163  
    216216      IF(lwp) THEN 
    217217         WRITE(numout,*) 
    218          IF( nspg == np_EXP )   WRITE(numout,*) '     explicit free surface' 
    219          IF( nspg == np_TS  )   WRITE(numout,*) '     free surface with time splitting scheme' 
    220          IF( nspg == np_NO  )   WRITE(numout,*) '     No surface surface pressure gradient trend in momentum Eqs.' 
     218         IF( nspg == np_EXP )   WRITE(numout,*) '      ===>>   explicit free surface' 
     219         IF( nspg == np_TS  )   WRITE(numout,*) '      ===>>   free surface with time splitting scheme' 
     220         IF( nspg == np_NO  )   WRITE(numout,*) '      ===>>   No surface surface pressure gradient trend in momentum Eqs.' 
    221221      ENDIF 
    222222      ! 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r6140 r7163  
    626626         WRITE(numout,*) 'dyn_vor_init : vorticity term : read namelist and control the consistency' 
    627627         WRITE(numout,*) '~~~~~~~~~~~~' 
    628          WRITE(numout,*) '        Namelist namdyn_vor : choice of the vorticity term scheme' 
    629          WRITE(numout,*) '           energy    conserving scheme                    ln_dynvor_ene = ', ln_dynvor_ene 
    630          WRITE(numout,*) '           enstrophy conserving scheme                    ln_dynvor_ens = ', ln_dynvor_ens 
    631          WRITE(numout,*) '           mixed enstrophy/energy conserving scheme       ln_dynvor_mix = ', ln_dynvor_mix 
    632          WRITE(numout,*) '           enstrophy and energy conserving scheme         ln_dynvor_een = ', ln_dynvor_een 
    633          WRITE(numout,*) '              e3f = averaging /4 (=0) or /sum(tmask) (=1)    nn_een_e3f = ', nn_een_e3f 
    634          WRITE(numout,*) '           masked (=T) or unmasked(=F) vorticity          ln_dynvor_msk = ', ln_dynvor_msk 
     628         WRITE(numout,*) '   Namelist namdyn_vor : choice of the vorticity term scheme' 
     629         WRITE(numout,*) '      energy    conserving scheme                    ln_dynvor_ene = ', ln_dynvor_ene 
     630         WRITE(numout,*) '      enstrophy conserving scheme                    ln_dynvor_ens = ', ln_dynvor_ens 
     631         WRITE(numout,*) '      mixed enstrophy/energy conserving scheme       ln_dynvor_mix = ', ln_dynvor_mix 
     632         WRITE(numout,*) '      enstrophy and energy conserving scheme         ln_dynvor_een = ', ln_dynvor_een 
     633         WRITE(numout,*) '         e3f = averaging /4 (=0) or /sum(tmask) (=1)    nn_een_e3f = ', nn_een_e3f 
     634         WRITE(numout,*) '      masked (=T) or unmasked(=F) vorticity          ln_dynvor_msk = ', ln_dynvor_msk 
    635635      ENDIF 
    636636 
    … …  
    639639      ! at angles with three ocean points and one land point 
    640640      IF(lwp) WRITE(numout,*) 
    641       IF(lwp) WRITE(numout,*) '           namlbc: change fmask value in the angles (T)   ln_vorlat = ', ln_vorlat 
     641      IF(lwp) WRITE(numout,*) '      change fmask value in the angles (T)           ln_vorlat = ', ln_vorlat 
    642642      IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN 
    643643         DO jk = 1, jpk 
    … …  
    666666      ncor = np_COR 
    667667      IF( ln_dynadv_vec ) THEN      
    668          IF(lwp) WRITE(numout,*) '         Vector form advection : vorticity = Coriolis + relative vorticity' 
     668         IF(lwp) WRITE(numout,*) '      ===>>   Vector form advection : vorticity = Coriolis + relative vorticity' 
    669669         nrvm = np_RVO        ! relative vorticity 
    670670         ntot = np_CRV        ! relative + planetary vorticity 
    671671      ELSE                         
    672          IF(lwp) WRITE(numout,*) '         Flux form advection   : vorticity = Coriolis + metric term' 
     672         IF(lwp) WRITE(numout,*) '      ===>>   Flux form advection   : vorticity = Coriolis + metric term' 
    673673         nrvm = np_MET        ! metric term 
    674674         ntot = np_CME        ! Coriolis + metric term 
    … …  
    677677      IF(lwp) THEN                   ! Print the choice 
    678678         WRITE(numout,*) 
    679          IF( nvor_scheme ==  np_ENE )   WRITE(numout,*) '         vorticity scheme ==>> energy conserving scheme' 
    680          IF( nvor_scheme ==  np_ENS )   WRITE(numout,*) '         vorticity scheme ==>> enstrophy conserving scheme' 
    681          IF( nvor_scheme ==  np_MIX )   WRITE(numout,*) '         vorticity scheme ==>> mixed enstrophy/energy conserving scheme' 
    682          IF( nvor_scheme ==  np_EEN )   WRITE(numout,*) '         vorticity scheme ==>> energy and enstrophy conserving scheme' 
     679         IF( nvor_scheme ==  np_ENE )   WRITE(numout,*) '      ===>>  energy conserving scheme' 
     680         IF( nvor_scheme ==  np_ENS )   WRITE(numout,*) '      ===>>  enstrophy conserving scheme' 
     681         IF( nvor_scheme ==  np_MIX )   WRITE(numout,*) '      ===>>  mixed enstrophy/energy conserving scheme' 
     682         IF( nvor_scheme ==  np_EEN )   WRITE(numout,*) '      ===>>  energy and enstrophy conserving scheme' 
    683683      ENDIF 
    684684      ! 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90

    r6140 r7163  
    119119         WRITE(numout,*) 'dyn_zdf_init : vertical dynamics physics scheme' 
    120120         WRITE(numout,*) '~~~~~~~~~~~' 
    121          IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme' 
    122          IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme' 
     121         IF( nzdf ==  0 )   WRITE(numout,*) '      ===>>   Explicit time-splitting scheme' 
     122         IF( nzdf ==  1 )   WRITE(numout,*) '      ===>>   Implicit (euler backward) scheme' 
    123123      ENDIF 
    124124      ! 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90

    r6152 r7163  
    1  
    21MODULE wet_dry 
    32   !!============================================================================== 
    … …  
    7776         WRITE(numout,*) 
    7877         WRITE(numout,*) 'wad_init : Wetting and drying initialization through namelist read' 
    79          WRITE(numout,*) '~~~~~~~ ' 
     78         WRITE(numout,*) '~~~~~~~~' 
    8079         WRITE(numout,*) '   Namelist namwad' 
    8180         WRITE(numout,*) '      Logical activation                 ln_wd      = ', ln_wd 
    … …  
    116115      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu,  zflxv            ! local 2D workspace 
    117116      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace 
    118  
    119117      !!---------------------------------------------------------------------- 
    120118      ! 
    … …  
    246244   END SUBROUTINE wad_lmt 
    247245 
     246 
    248247   SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rdtbt ) 
    249248      !!---------------------------------------------------------------------- 
    … …  
    269268      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! local 2D workspace 
    270269      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace 
    271  
    272270      !!---------------------------------------------------------------------- 
    273271      ! 
    … …  
    389387 
    390388      IF( nn_timing == 1 )  CALL timing_stop('wad_lmt') 
     389      ! 
    391390   END SUBROUTINE wad_lmt_bt 
     391 
     392   !!============================================================================== 
    392393END MODULE wet_dry 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90

    r5215 r7163  
    372372      IF(lwp) THEN 
    373373         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,*) ' namelist namberg not read' 
     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' 
    377377      ENDIF 
    378378      ln_icebergs = .false.       
    … …  
    381381         IF(lwp) THEN 
    382382            WRITE(numout,*) 
    383             WRITE(numout,*) 'icbini :   Namelist namberg ln_icebergs = F , NO icebergs used' 
    384             WRITE(numout,*) '~~~~~~~~ ' 
     383            WRITE(numout,*) 'icbini : Namelist namberg ln_icebergs = F , NO icebergs used' 
     384            WRITE(numout,*) '~~~~~~ ' 
    385385         ENDIF 
    386386         RETURN 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r6140 r7163  
    1818   PUBLIC 
    1919 
    20   
    21    ! 
    2220   !!---------------------------------------------------------------------- 
    2321   !!                   namrun namelist parameters 
    … …  
    9593   !!                    output monitoring 
    9694   !!---------------------------------------------------------------------- 
    97    LOGICAL ::   ln_ctl       !: run control for debugging 
    98    INTEGER ::   nn_timing    !: run control for timing 
    99    INTEGER ::   nn_diacfl    !: flag whether to create CFL diagnostics 
    100    INTEGER ::   nn_print     !: level of print (0 no print) 
    101    INTEGER ::   nn_ictls     !: Start i indice for the SUM control 
    102    INTEGER ::   nn_ictle     !: End   i indice for the SUM control 
    103    INTEGER ::   nn_jctls     !: Start j indice for the SUM control 
    104    INTEGER ::   nn_jctle     !: End   j indice for the SUM control 
    105    INTEGER ::   nn_isplt     !: number of processors following i 
    106    INTEGER ::   nn_jsplt     !: number of processors following j 
    107    INTEGER ::   nn_bench     !: benchmark parameter (0/1) 
    108    INTEGER ::   nn_bit_cmp   =    0    !: bit reproducibility  (0/1) 
    109  
     95   LOGICAL ::   ln_ctl           !: run control for debugging 
     96   INTEGER ::   nn_timing        !: run control for timing 
     97   INTEGER ::   nn_diacfl        !: flag whether to create CFL diagnostics 
     98   INTEGER ::   nn_print         !: level of print (0 no print) 
     99   INTEGER ::   nn_ictls         !: Start i indice for the SUM control 
     100   INTEGER ::   nn_ictle         !: End   i indice for the SUM control 
     101   INTEGER ::   nn_jctls         !: Start j indice for the SUM control 
     102   INTEGER ::   nn_jctle         !: End   j indice for the SUM control 
     103   INTEGER ::   nn_isplt         !: number of processors following i 
     104   INTEGER ::   nn_jsplt         !: number of processors following j 
     105   INTEGER ::   nn_bench         !: benchmark parameter (0/1) 
     106   INTEGER ::   nn_bit_cmp = 0   !: bit reproducibility  (0/1) 
    110107   !                                           
    111108   INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt, nbench    !: OLD namelist names 
    … …  
    138135   !!                          Run control   
    139136   !!---------------------------------------------------------------------- 
     137   INTEGER       ::   no_print = 0          !: optional argument of fld_fill (if present, suppress some control print) 
    140138   INTEGER       ::   nstop = 0             !: error flag (=number of reason for a premature stop run) 
    141139   INTEGER       ::   nwarn = 0             !: warning flag (=number of warning found during the run) 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r6490 r7163  
    43034303            WRITE(kout,*) 
    43044304         ENDIF 
     4305         CALL FLUSH(kout)  
    43054306         STOP 'ctl_opn bad opening' 
    43064307      ENDIF 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r6412 r7163  
    6565         WRITE(numout,*) 
    6666         WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing' 
    67          WRITE(numout,*) '~~~~~~~~~~~: ' 
     67         WRITE(numout,*) '~~~~~~~~~~~ ' 
    6868         WRITE(numout,*) '         nperio = ', nperio 
    6969         WRITE(numout,*) '         npolj  = ', npolj 
    … …  
    265265       
    266266      IF(lwp) WRITE(numout,*) 
    267       IF(lwp) WRITE(numout,*) ' mpp_init: defines mpp subdomains' 
    268       IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------' 
    269       IF(lwp) WRITE(numout,*) 
    270       IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj 
    271       IF(lwp) WRITE(numout,*) 
    272       IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj 
     267      IF(lwp) WRITE(numout,*) '   defines mpp subdomains' 
     268      IF(lwp) WRITE(numout,*) '      jpni=', jpni, ' iresti=', iresti 
     269      IF(lwp) WRITE(numout,*) '      jpnj=', jpnj, ' irestj=', irestj 
    273270      zidom = nreci 
    274271      DO ji = 1, jpni 
    … …  
    276273      END DO 
    277274      IF(lwp) WRITE(numout,*) 
    278       IF(lwp) WRITE(numout,*)' sum ilcit(i,1)=', zidom, ' jpiglo=', jpiglo 
     275      IF(lwp) WRITE(numout,*)'      sum ilcit(i,1)=', zidom, ' jpiglo=', jpiglo 
    279276 
    280277      zjdom = nrecj 
    … …  
    282279         zjdom = zjdom + ilcjt(1,jj) - nrecj 
    283280      END DO 
    284       IF(lwp) WRITE(numout,*)' sum ilcit(1,j)=', zjdom, ' jpjglo=', jpjglo 
    285       IF(lwp) WRITE(numout,*) 
     281      IF(lwp) WRITE(numout,*)'      sum ilcit(1,j)=', zjdom, ' jpjglo=', jpjglo 
    286282 
    287283      IF(lwp) THEN 
    … …  
    360356      njmpp  = njmppt(narea)   
    361357 
    362      ! Save processor layout in layout.dat file  
    363        IF (lwp) THEN 
    364         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
    365         WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo' 
    366         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo 
    367         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp' 
    368  
    369         DO jn = 1, jpnij 
    370          WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), & 
    371                                       nldit(jn), nldjt(jn), & 
    372                                       nleit(jn), nlejt(jn), & 
    373                                       nimppt(jn), njmppt(jn) 
    374         END DO 
    375         CLOSE(inum)    
     358      ! Save processor layout in layout.dat file  
     359      IF(lwp) THEN 
     360         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
     361         WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo' 
     362         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo 
     363         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp' 
     364         ! 
     365         DO jn = 1, jpnij 
     366            WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), & 
     367               &                    nldit(jn), nldjt(jn), & 
     368               &                    nleit(jn), nlejt(jn), & 
     369               &                    nimppt(jn), njmppt(jn) 
     370         END DO 
     371         CLOSE(inum)    
    376372      END IF 
    377  
    378373 
    379374      ! w a r n i n g  narea (zone) /= nproc (processors)! 
    … …  
    428423 
    429424      IF(lwp) THEN 
    430          WRITE(numout,*) ' nproc  = ', nproc 
    431          WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea 
    432          WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso 
    433          WRITE(numout,*) ' nbondi = ', nbondi 
    434          WRITE(numout,*) ' nbondj = ', nbondj 
    435          WRITE(numout,*) ' npolj  = ', npolj 
    436          WRITE(numout,*) ' nperio = ', nperio 
    437          WRITE(numout,*) ' nlci   = ', nlci 
    438          WRITE(numout,*) ' nlcj   = ', nlcj 
    439          WRITE(numout,*) ' nimpp  = ', nimpp 
    440          WRITE(numout,*) ' njmpp  = ', njmpp 
    441          WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse 
    442          WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw 
    443          WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne 
    444          WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw 
     425         WRITE(numout,*) '      nproc  = ', nproc 
     426         WRITE(numout,*) '      nowe   = ', nowe  , '      noea   =  ', noea 
     427         WRITE(numout,*) '      nono   = ', nono  , '      noso   =  ', noso 
     428         WRITE(numout,*) '      nbondi = ', nbondi, '      nbondj = ', nbondj 
     429         WRITE(numout,*) '      npolj  = ', npolj 
     430         WRITE(numout,*) '      nperio = ', nperio 
     431         WRITE(numout,*) '      nlci   = ', nlci  , '      nlcj   = ', nlcj 
     432         WRITE(numout,*) '      nimpp  = ', nimpp , '      njmpp  = ', njmpp 
     433         WRITE(numout,*) '      nreci  = ', nreci , '      npse   = ', npse 
     434         WRITE(numout,*) '      nrecj  = ', nrecj , '      npsw   = ', npsw 
     435         WRITE(numout,*) '      jpreci = ', jpreci, '      npne   = ', npne 
     436         WRITE(numout,*) '      jprecj = ', jprecj, '      npnw   = ', npnw 
    445437         WRITE(numout,*) 
    446438      ENDIF 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90

    r6140 r7163  
    5959      REAL(wp) ::   zw    , zdep2   !   -      - 
    6060      !!---------------------------------------------------------------------- 
     61 
     62      IF(lwp) THEN 
     63         WRITE(numout,*) 
     64         WRITE(numout,*) '   ldf_c1d : set a given profile to eddy diffusivity/viscosity coefficients' 
     65         WRITE(numout,*) '   ~~~~~~~' 
     66      ENDIF 
    6167 
    6268      ! initialization of the profile 
    … …  
    130136      ! 
    131137      IF(lwp) THEN 
    132          WRITE(numout,*) 'ldf_c2d :     aht = rn_aht0 *  max(e1,e2)/e_equator     (  laplacian) ' 
    133          WRITE(numout,*) '~~~~~~~       or  = rn_bht0 * [max(e1,e2)/e_equator]**3 (bilaplacian)' 
     138         WRITE(numout,*) 
     139         WRITE(numout,*) '   ldf_c2d :     aht = rn_aht0 *  max(e1,e2)/e_equator     (  laplacian) ' 
     140         WRITE(numout,*) '   ~~~~~~~       or  = rn_bht0 * [max(e1,e2)/e_equator]**3 (bilaplacian)' 
    134141         WRITE(numout,*) 
    135142      ENDIF 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r6723 r7163  
    44   !! Ocean forcing:  read input field for surface boundary condition 
    55   !!===================================================================== 
    6    !! History :  2.0  !  06-2006  (S. Masson, G. Madec)  Original code 
    7    !!                 !  05-2008  (S. Alderson)  Modified for Interpolation in memory from input grid to model grid 
    8    !!                 !  10-2013  (D. Delrosso, P. Oddo)  suppression of land point prior to interpolation 
     6   !! History :  2.0  !  2006-06  (S. Masson, G. Madec)  Original code 
     7   !!            3.0  !  2008-05  (S. Alderson)  Modified for Interpolation in memory from input grid to model grid 
     8   !!            3.4  !  2013-10  (D. Delrosso, P. Oddo)  suppression of land point prior to interpolation 
    99   !!---------------------------------------------------------------------- 
    1010 
    1111   !!---------------------------------------------------------------------- 
    12    !!   fld_read      : read input fields used for the computation of the 
    13    !!                   surface boundary condition 
     12   !!   fld_read      : read input fields used for the computation of the surface boundary condition 
     13   !!   fld_init      : initialization of field read 
     14   !!   fld_rec       : determined the record(s) to be read 
     15   !!   fld_get       : read the data 
     16   !!   fld_map       : read global data from file and map onto local data using a general mapping (use for open boundaries) 
     17   !!   fld_rot       : rotate the vector fields onto the local grid direction 
     18   !!   fld_clopn     : update the data file name and close/open the files 
     19   !!   fld_fill      : fill the data structure with the associated information read in namelist 
     20   !!   wgt_list      : manage the weights used for interpolation 
     21   !!   wgt_print     : print the list of known weights 
     22   !!   fld_weight    : create a WGT structure and fill in data from file, restructuring as required 
     23   !!   apply_seaoverland : fill land with ocean values 
     24   !!   seaoverland   : create shifted matrices for seaoverland application 
     25   !!   fld_interp    : apply weights to input gridded data to create data on model grid 
     26   !!   ksec_week     : function returning the first 3 letters of the first day of the weekly file 
    1427   !!---------------------------------------------------------------------- 
    1528   USE oce            ! ocean dynamics and tracers 
    … …  
    274287            IF( sd(jf)%ln_tint ) THEN              ! temporal interpolation 
    275288               IF(lwp .AND. kt - nit000 <= 100 ) THEN  
    276                   clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
     289                  clfmt = "('   fld_read: var ', a, ' kt = ', i8, ' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
    277290                     &    "', records b/a: ', i6.4, '/', i6.4, ' (days ', f9.4,'/', f9.4, ')')" 
    278291                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &             
    279292                     & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 
    280                   WRITE(numout, *) 'it_offset is : ',it_offset 
     293                  WRITE(numout, *) '      it_offset is : ',it_offset 
    281294               ENDIF 
    282295               ! temporal interpolation weights 
    … …  
    286299            ELSE   ! nothing to do... 
    287300               IF(lwp .AND. kt - nit000 <= 100 ) THEN 
    288                   clfmt = "('fld_read: var ', a, ' kt = ', i8,' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
     301                  clfmt = "('   fld_read: var ', a, ' kt = ', i8,' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
    289302                     &    "', record: ', i6.4, ' (days ', f9.4, ' <-> ', f9.4, ')')" 
    290303                  WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,    & 
    … …  
    407420         CALL fld_get( sdjf, map )         ! read before data in after arrays(as we will swap it later) 
    408421         ! 
    409          clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i6, ' at time = ', f7.2, ' days')" 
     422         clfmt = "('   fld_init : time-interpolation for ', a, ' read previous record = ', i6, ' at time = ', f7.2, ' days')" 
    410423         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday 
    411424         ! 
    … …  
    791804      !!                    ***  ROUTINE fld_clopn  *** 
    792805      !! 
    793       !! ** Purpose :   update the file name and open the file 
     806      !! ** Purpose :   update the file name and close/open the files 
    794807      !!---------------------------------------------------------------------- 
    795808      TYPE(FLD)        , INTENT(inout) ::   sdjf     ! input field related variables 
    … …  
    882895 
    883896 
    884    SUBROUTINE fld_fill( sdf, sdf_n, cdir, cdcaller, cdtitle, cdnam ) 
     897   SUBROUTINE fld_fill( sdf, sdf_n, cdir, cdcaller, cdtitle, cdnam, knoprint ) 
    885898      !!--------------------------------------------------------------------- 
    886899      !!                    ***  ROUTINE fld_fill  *** 
    887900      !! 
    888       !! ** Purpose :   fill sdf with sdf_n and control print 
    889       !!---------------------------------------------------------------------- 
    890       TYPE(FLD)  , DIMENSION(:), INTENT(inout) ::   sdf        ! structure of input fields (file informations, fields read) 
    891       TYPE(FLD_N), DIMENSION(:), INTENT(in   ) ::   sdf_n      ! array of namelist information structures 
    892       CHARACTER(len=*)         , INTENT(in   ) ::   cdir       ! Root directory for location of flx files 
    893       CHARACTER(len=*)         , INTENT(in   ) ::   cdcaller   !  
    894       CHARACTER(len=*)         , INTENT(in   ) ::   cdtitle    !  
    895       CHARACTER(len=*)         , INTENT(in   ) ::   cdnam      !  
    896       ! 
    897       INTEGER  ::   jf       ! dummy indices 
     901      !! ** Purpose :   fill the data structure (sdf) with the associated information  
     902      !!              read in namelist (sdf_n) and control print 
     903      !!---------------------------------------------------------------------- 
     904      TYPE(FLD)  , DIMENSION(:)          , INTENT(inout) ::   sdf        ! structure of input fields (file informations, fields read) 
     905      TYPE(FLD_N), DIMENSION(:)          , INTENT(in   ) ::   sdf_n      ! array of namelist information structures 
     906      CHARACTER(len=*)                   , INTENT(in   ) ::   cdir       ! Root directory for location of flx files 
     907      CHARACTER(len=*)                   , INTENT(in   ) ::   cdcaller   ! name of the calling routine 
     908      CHARACTER(len=*)                   , INTENT(in   ) ::   cdtitle    ! description of the calling routine  
     909      CHARACTER(len=*)                   , INTENT(in   ) ::   cdnam      ! name of the namelist from which sdf_n comes 
     910      INTEGER                  , OPTIONAL, INTENT(in   ) ::   knoprint   ! no calling routine information printed 
     911      ! 
     912      INTEGER  ::   jf   ! dummy indices 
    898913      !!--------------------------------------------------------------------- 
    899914      ! 
    … …  
    922937      IF(lwp) THEN      ! control print 
    923938         WRITE(numout,*) 
    924          WRITE(numout,*) TRIM( cdcaller )//' : '//TRIM( cdtitle ) 
    925          WRITE(numout,*) (/ ('~', jf = 1, LEN_TRIM( cdcaller ) ) /) 
    926          WRITE(numout,*) '   Namelist '//TRIM( cdnam ) 
     939         IF( .NOT.PRESENT( knoprint) ) THEN 
     940            WRITE(numout,*) TRIM( cdcaller )//' : '//TRIM( cdtitle ) 
     941            WRITE(numout,*) (/ ('~', jf = 1, LEN_TRIM( cdcaller ) ) /) 
     942         ENDIF 
     943         WRITE(numout,*) '   fld_fill : fill data structure with information from namelist '//TRIM( cdnam ) 
     944         WRITE(numout,*) '   ~~~~~~~~' 
    927945         WRITE(numout,*) '      list of files and frequency (>0: in hours ; <0 in months)' 
    928946         DO jf = 1, SIZE(sdf) 
    929             WRITE(numout,*) '      root filename: '  , TRIM( sdf(jf)%clrootname ), '   variable name: ', TRIM( sdf(jf)%clvar) 
     947            WRITE(numout,*) '      root filename: '  , TRIM( sdf(jf)%clrootname ), '   variable name: ', TRIM( sdf(jf)%clvar ) 
    930948            WRITE(numout,*) '         frequency: '      ,       sdf(jf)%nfreqh      ,   & 
    931949               &                  '   time interp: '    ,       sdf(jf)%ln_tint     ,   & 
    … …  
    946964      !!                    ***  ROUTINE wgt_list  *** 
    947965      !! 
    948       !! ** Purpose :   search array of WGTs and find a weights file 
    949       !!                entry, or return a new one adding it to the end 
    950       !!                if it is a new entry, the weights data is read in and 
    951       !!                restructured (fld_weight) 
     966      !! ** Purpose :   search array of WGTs and find a weights file entry, 
     967      !!                or return a new one adding it to the end if new entry. 
     968      !!                the weights data is read in and restructured (fld_weight) 
    952969      !!---------------------------------------------------------------------- 
    953970      TYPE( FLD ), INTENT(in   ) ::   sd        ! field with name of weights file 
    … …  
    10181035      !!                    ***  ROUTINE fld_weight  *** 
    10191036      !! 
    1020       !! ** Purpose :   create a new WGT structure and fill in data from   
    1021       !!                file, restructuring as required 
     1037      !! ** Purpose :   create a new WGT structure and fill in data from file, 
     1038      !!              restructuring as required 
    10221039      !!---------------------------------------------------------------------- 
    10231040      TYPE( FLD ), INTENT(in) ::   sd   ! field with name of weights file 
    … …  
    11621179 
    11631180   SUBROUTINE apply_seaoverland( clmaskfile, zfieldo, jpi1_lsm, jpi2_lsm, jpj1_lsm,   & 
    1164                           &      jpj2_lsm, itmpi, itmpj, itmpz, rec1_lsm, recn_lsm ) 
     1181      &                          jpj2_lsm, itmpi, itmpj, itmpz, rec1_lsm, recn_lsm ) 
    11651182      !!--------------------------------------------------------------------- 
    11661183      !!                    ***  ROUTINE apply_seaoverland  *** 
    … …  
    14911508      !!                    ***  FUNCTION kshift_week ***  
    14921509      !! 
    1493       !! ** Purpose :   
    1494       !!--------------------------------------------------------------------- 
    1495       CHARACTER(len=*), INTENT(in)   ::   cdday   !3 first letters of the first day of the weekly file 
    1496       !! 
    1497       INTEGER                        ::   ksec_week  ! output variable 
    1498       INTEGER                        ::   ijul       !temp variable 
    1499       INTEGER                        ::   ishift     !temp variable 
     1510      !! ** Purpose :   return the first 3 letters of the first day of the weekly file 
     1511      !!--------------------------------------------------------------------- 
     1512      CHARACTER(len=*), INTENT(in)   ::   cdday   ! first 3 letters of the first day of the weekly file 
     1513      !! 
     1514      INTEGER                        ::   ksec_week      ! output variable 
     1515      INTEGER                        ::   ijul, ishift   ! local integer 
    15001516      CHARACTER(len=3),DIMENSION(7)  ::   cl_week  
    15011517      !!---------------------------------------------------------------------- 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90

    r6727 r7163  
    66   !!                        SUCCESSOR OF "sbcblk_core" 
    77   !!===================================================================== 
    8    !! History :  1.0  !  2004-08  (U. Schweckendiek)  Original code 
    9    !!            2.0  !  2005-04  (L. Brodeau, A.M. Treguier) additions: 
    10    !!                           -  new bulk routine for efficiency 
    11    !!                           -  WINDS ARE NOW ASSUMED TO BE AT T POINTS in input files 
    12    !!                           -  file names and file characteristics in namelist 
    13    !!                           -  Implement reading of 6-hourly fields 
    14    !!            3.0  !  2006-06  (G. Madec) sbc rewritting 
    15    !!             -   !  2006-12  (L. Brodeau) Original code for turb_core 
     8   !! History :  1.0  !  2004-08  (U. Schweckendiek)  Original CORE code 
     9   !!            2.0  !  2005-04  (L. Brodeau, A.M. Treguier)  improved CORE bulk and its user interface 
     10   !!            3.0  !  2006-06  (G. Madec)  sbc rewritting 
     11   !!             -   !  2006-12  (L. Brodeau)  Original code for turb_core 
    1612   !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put 
    1713   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle 
    18    !!            3.4  !  2011-11  (C. Harris) Fill arrays required by CICE 
    19    !!            3.7  !  2014-06  (L. Brodeau) simplification and optimization of CORE bulk 
    20    !!            4.0  !  2016-06  (L. Brodeau) sbcblk_core becomes sbcblk and is not restricted to the CORE algorithm anymore 
     14   !!            3.4  !  2011-11  (C. Harris)  Fill arrays required by CICE 
     15   !!            3.7  !  2014-06  (L. Brodeau)  simplification and optimization of CORE bulk 
     16   !!            4.0  !  2016-06  (L. Brodeau)  sbcblk_core becomes sbcblk and is not restricted to the CORE algorithm anymore 
    2117   !!                                          ==> based on AeroBulk (http://aerobulk.sourceforge.net/) 
     18   !!            4.0  !  2016-10  (G. Madec)  introduce a sbc_blk_init routine 
    2219   !!---------------------------------------------------------------------- 
    2320 
    2421   !!---------------------------------------------------------------------- 
    25    !!   sbc_blk       : bulk formulation as ocean surface boundary condition (forced mode, CORE bulk formulea) 
     22   !!   sbc_blk_init  : initialisation of the chosen bulk formulation as ocean surface boundary condition 
     23   !!   sbc_blk       : bulk formulation as ocean surface boundary condition 
    2624   !!   blk_oce       : computes momentum, heat and freshwater fluxes over ocean 
    27    !!   blk_ice       : computes momentum, heat and freshwater fluxes over ice 
     25   !!   blk_ice       : computes momentum, heat and freshwater fluxes over sea ice 
    2826   !!   rho_air       : density of (moist) air (depends on T_air, q_air and SLP 
    2927   !!   cp_air        : specific heat of (moist) air (depends spec. hum. q_air) 
    … …  
    6462   PRIVATE 
    6563 
    66    PUBLIC   sbc_blk       ! routine called in sbcmod module 
     64   PUBLIC   sbc_blk_init  ! called in sbcmod 
     65   PUBLIC   sbc_blk       ! called in sbcmod 
    6766#if defined key_lim2 || defined key_lim3 
    6867   PUBLIC   blk_ice_tau   ! routine called in sbc_ice_lim module 
    … …  
    8281   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    8382   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point 
    84    INTEGER , PARAMETER ::   jp_humi = 3           ! index of specific humidity               ( % ) 
    85    INTEGER , PARAMETER ::   jp_qsr  = 4           ! index of solar heat                      (W/m2) 
    86    INTEGER , PARAMETER ::   jp_qlw  = 5           ! index of Long wave                       (W/m2) 
    87    INTEGER , PARAMETER ::   jp_tair = 6           ! index of 10m air temperature             (Kelvin) 
     83   INTEGER , PARAMETER ::   jp_tair = 3           ! index of 10m air temperature             (Kelvin) 
     84   INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( % ) 
     85   INTEGER , PARAMETER ::   jp_qsr  = 5           ! index of solar heat                      (W/m2) 
     86   INTEGER , PARAMETER ::   jp_qlw  = 6           ! index of Long wave                       (W/m2) 
    8887   INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s) 
    8988   INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s) 
    … …  
    129128CONTAINS 
    130129 
     130   SUBROUTINE sbc_blk_init 
     131      !!--------------------------------------------------------------------- 
     132      !!                    ***  ROUTINE sbc_blk_init  *** 
     133      !! 
     134      !! ** Purpose :   choose and initialize a bulk formulae formulation 
     135      !! 
     136      !! ** Method  :  
     137      !! 
     138      !!      C A U T I O N : never mask the surface stress fields 
     139      !!                      the stress is assumed to be in the (i,j) mesh referential 
     140      !! 
     141      !! ** Action  :    
     142      !! 
     143      !!---------------------------------------------------------------------- 
     144      INTEGER  ::   ifpr, jfld            ! dummy loop indice and argument 
     145      INTEGER  ::   ios, ierror, ioptio   ! Local integer 
     146      !! 
     147      CHARACTER(len=100)            ::   cn_dir                ! Root directory for location of atmospheric forcing files 
     148      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read 
     149      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read 
     150      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !       "                        " 
     151      TYPE(FLD_N) ::   sn_slp , sn_tdif                        !       "                        " 
     152      NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields 
     153         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif,                & 
     154         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF,             &   ! bulk algorithm 
     155         &                 cn_dir , ln_taudif, rn_zqt, rn_zu, rn_pfac, rn_efac, rn_vfac 
     156      !!--------------------------------------------------------------------- 
     157      ! 
     158      !                             !** read bulk namelist   
     159      REWIND( numnam_ref )                !* Namelist namsbc_blk in reference namelist : bulk parameters 
     160      READ  ( numnam_ref, namsbc_blk, IOSTAT = ios, ERR = 901) 
     161901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_blk in reference namelist', lwp ) 
     162      ! 
     163      REWIND( numnam_cfg )                !* Namelist namsbc_blk in configuration namelist : bulk parameters 
     164      READ  ( numnam_cfg, namsbc_blk, IOSTAT = ios, ERR = 902 ) 
     165902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_blk in configuration namelist', lwp ) 
     166      ! 
     167      IF(lwm) WRITE( numond, namsbc_blk ) 
     168      ! 
     169      !                             !** initialization of the chosen bulk formulae (+ check) 
     170      !                                   !* select the bulk chosen in the namelist and check the choice 
     171      ;                                                        ioptio = 0 
     172      IF( ln_NCAR      ) THEN   ;   nblk =  np_NCAR        ;   ioptio = ioptio + 1   ;   ENDIF 
     173      IF( ln_COARE_3p0 ) THEN   ;   nblk =  np_COARE_3p0   ;   ioptio = ioptio + 1   ;   ENDIF 
     174      IF( ln_COARE_3p5 ) THEN   ;   nblk =  np_COARE_3p5   ;   ioptio = ioptio + 1   ;   ENDIF 
     175      IF( ln_ECMWF     ) THEN   ;   nblk =  np_ECMWF       ;   ioptio = ioptio + 1   ;   ENDIF 
     176      ! 
     177      IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one bulk algorithm' ) 
     178      ! 
     179      IF( ln_dm2dc ) THEN                 !* check: diurnal cycle on Qsr 
     180         IF( sn_qsr%nfreqh /= 24 )   CALL ctl_stop( 'sbc_blk_init: ln_dm2dc=T only with daily short-wave input' ) 
     181         IF( sn_qsr%ln_tint ) THEN  
     182            CALL ctl_warn( 'sbc_blk_init: ln_dm2dc=T daily qsr time interpolation done by sbcdcy module',   & 
     183               &           '              ==> We force time interpolation = .false. for qsr' ) 
     184            sn_qsr%ln_tint = .false. 
     185         ENDIF 
     186      ENDIF 
     187      !                                   !* set the bulk structure 
     188      !                                      !- store namelist information in an array 
     189      slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj 
     190      slf_i(jp_qsr ) = sn_qsr    ;   slf_i(jp_qlw ) = sn_qlw 
     191      slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi 
     192      slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow 
     193      slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_tdif) = sn_tdif 
     194      ! 
     195      lhftau = ln_taudif                     !- add an extra field if HF stress is used 
     196      jfld = jpfld - COUNT( (/.NOT.lhftau/) ) 
     197      ! 
     198      !                                      !- allocate the bulk structure 
     199      ALLOCATE( sf(jfld), STAT=ierror ) 
     200      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_init: unable to allocate sf structure' ) 
     201      DO ifpr= 1, jfld 
     202         ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
     203         IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
     204      END DO 
     205      !                                      !- fill the bulk structure with namelist informations 
     206      CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 
     207      ! 
     208      !            
     209      IF(lwp) THEN                     !** Control print 
     210         ! 
     211         WRITE(numout,*)                  !* namelist  
     212         WRITE(numout,*) '   Namelist namsbc_blk (other than data information):' 
     213         WRITE(numout,*) '      "NCAR"      algorithm   (Large and Yeager 2008)     ln_NCAR      = ', ln_NCAR 
     214         WRITE(numout,*) '      "COARE 3.0" algorithm   (Fairall et al. 2003)       ln_COARE_3p0 = ', ln_COARE_3p0 
     215         WRITE(numout,*) '      "COARE 3.5" algorithm   (Edson et al. 2013)         ln_COARE_3p5 = ', ln_COARE_3p0 
     216         WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 31)              ln_ECMWF     = ', ln_ECMWF 
     217         WRITE(numout,*) '      add High freq.contribution to the stress module     ln_taudif    = ', ln_taudif 
     218         WRITE(numout,*) '      Air temperature and humidity reference height (m)   rn_zqt       = ', rn_zqt 
     219         WRITE(numout,*) '      Wind vector reference height (m)                    rn_zu        = ', rn_zu 
     220         WRITE(numout,*) '      factor applied on precipitation (total & snow)      rn_pfac      = ', rn_pfac 
     221         WRITE(numout,*) '      factor applied on evaporation                       rn_efac      = ', rn_efac 
     222         WRITE(numout,*) '      factor applied on ocean/ice velocity                rn_vfac      = ', rn_vfac 
     223         WRITE(numout,*) '         (form absolute (=0) to relative winds(=1))' 
     224         ! 
     225         WRITE(numout,*) 
     226         SELECT CASE( nblk )              !* Print the choice of bulk algorithm 
     227         CASE( np_NCAR      )   ;   WRITE(numout,*) '      ===>>   "NCAR" algorithm        (Large and Yeager 2008)' 
     228         CASE( np_COARE_3p0 )   ;   WRITE(numout,*) '      ===>>   "COARE 3.0" algorithm   (Fairall et al. 2003)' 
     229         CASE( np_COARE_3p5 )   ;   WRITE(numout,*) '      ===>>   "COARE 3.5" algorithm   (Edson et al. 2013)' 
     230         CASE( np_ECMWF     )   ;   WRITE(numout,*) '      ===>>   "ECMWF" algorithm       (IFS cycle 31)' 
     231         END SELECT 
     232         ! 
     233      ENDIF 
     234      ! 
     235   END SUBROUTINE sbc_blk_init 
     236 
     237 
    131238   SUBROUTINE sbc_blk( kt ) 
    132239      !!--------------------------------------------------------------------- 
    … …  
    164271      !!---------------------------------------------------------------------- 
    165272      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    166       ! 
    167       INTEGER  ::   ifpr, jfld            ! dummy loop indice and argument 
    168       INTEGER  ::   ios, ierror, ioptio   ! Local integer 
    169       ! 
    170       CHARACTER(len=100)            ::   cn_dir                ! Root directory for location of atmospheric forcing files 
    171       TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read 
    172       TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read 
    173       TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !   "                                 " 
    174       TYPE(FLD_N) ::   sn_slp , sn_tdif                        !   "                                 " 
    175       NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields 
    176          &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif,                & 
    177          &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF,             &   ! bulk algorithm 
    178          &                 cn_dir , ln_taudif, rn_zqt, rn_zu, rn_pfac, rn_efac, rn_vfac 
    179       !!--------------------------------------------------------------------- 
    180       ! 
    181       !                                         ! ====================== ! 
    182       IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    183          !                                      ! ====================== ! 
    184          ! 
    185          REWIND( numnam_ref )              ! Namelist namsbc_blk in reference namelist : bulk parameters 
    186          READ  ( numnam_ref, namsbc_blk, IOSTAT = ios, ERR = 901) 
    187 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_blk in reference namelist', lwp ) 
    188          ! 
    189          REWIND( numnam_cfg )              ! Namelist namsbc_blk in configuration namelist : bulk parameters 
    190          READ  ( numnam_cfg, namsbc_blk, IOSTAT = ios, ERR = 902 ) 
    191 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_blk in configuration namelist', lwp ) 
    192          ! 
    193          IF(lwm) WRITE( numond, namsbc_blk ) 
    194          ! 
    195          !                          ! Control of surface pressure gradient scheme options 
    196          ;                                                        ioptio = 0 
    197          IF( ln_NCAR      ) THEN   ;   nblk =  np_NCAR        ;   ioptio = ioptio + 1   ;   ENDIF 
    198          IF( ln_COARE_3p0 ) THEN   ;   nblk =  np_COARE_3p0   ;   ioptio = ioptio + 1   ;   ENDIF 
    199          IF( ln_COARE_3p5 ) THEN   ;   nblk =  np_COARE_3p5   ;   ioptio = ioptio + 1   ;   ENDIF 
    200          IF( ln_ECMWF     ) THEN   ;   nblk =  np_ECMWF       ;   ioptio = ioptio + 1   ;   ENDIF 
    201          ! 
    202          IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk: Choose one and only one bulk algorithm' ) 
    203          ! 
    204          !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing? 
    205          IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   & 
    206             &   CALL ctl_stop( 'sbc_blk: ln_dm2dc can be activated only with daily short-wave forcing' ) 
    207          IF( ln_dm2dc .AND. sn_qsr%ln_tint ) THEN 
    208             CALL ctl_warn( 'sbc_blk: ln_dm2dc is taking care of the temporal interpolation of daily qsr',   & 
    209                &         '              ==> We force time interpolation = .false. for qsr' ) 
    210             sn_qsr%ln_tint = .false. 
    211          ENDIF 
    212          !                                         ! store namelist information in an array 
    213          slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj 
    214          slf_i(jp_qsr ) = sn_qsr    ;   slf_i(jp_qlw ) = sn_qlw 
    215          slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi 
    216          slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow 
    217          slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_tdif) = sn_tdif 
    218          ! 
    219          lhftau = ln_taudif                        ! do we use HF tau information? 
    220          jfld = jpfld - COUNT( (/.NOT. lhftau/) ) 
    221          ! 
    222          ALLOCATE( sf(jfld), STAT=ierror )         ! set sf structure 
    223          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk: unable to allocate sf structure' ) 
    224          DO ifpr= 1, jfld 
    225             ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    226             IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    227          END DO 
    228          !                                         ! fill sf with slf_i and control print 
    229          CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk', 'surface boundary condition -- bulk formula', 'namsbc_blk' ) 
    230          ! 
    231          IF(lwp) THEN                              ! Control print (other namelist variable) 
    232             WRITE(numout,*) 
    233             WRITE(numout,*) '      "NCAR"      algorithm   (Large and Yeager 2008)     ln_NCAR      = ', ln_NCAR 
    234             WRITE(numout,*) '      "COARE 3.0" algorithm   (Fairall et al. 2003)       ln_COARE_3p0 = ', ln_COARE_3p0 
    235             WRITE(numout,*) '      "COARE 3.5" algorithm   (Edson et al. 2013)         ln_COARE_3p5 = ', ln_COARE_3p0 
    236             WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 31)              ln_ECMWF     = ', ln_ECMWF 
    237             WRITE(numout,*) '      add High freq.contribution to the stress module     ln_taudif    = ', ln_taudif 
    238             WRITE(numout,*) '      Air temperature and humidity reference height (m)   rn_zqt       = ', rn_zqt 
    239             WRITE(numout,*) '      Wind vector reference height (m)                    rn_zu        = ', rn_zu 
    240             WRITE(numout,*) '      factor applied on precipitation (total & snow)      rn_pfac      = ', rn_pfac 
    241             WRITE(numout,*) '      factor applied on evaporation                       rn_efac      = ', rn_efac 
    242             WRITE(numout,*) '      factor applied on ocean/ice velocity                rn_vfac      = ', rn_vfac 
    243             WRITE(numout,*) '         (form absolute (=0) to relative winds(=1))' 
    244          ENDIF 
    245          ! 
    246          sfx(:,:) = 0._wp                          ! salt flux; zero unless ice is present (computed in limsbc(_2).F90) 
    247          ! 
    248          IF(lwp) THEN                           ! Print the choice of bulk algorithm 
    249             WRITE(numout,*) 
    250             SELECT CASE ( nblk ) 
    251             CASE( np_NCAR      )   ;   WRITE(numout,*) '         "NCAR" algorithm        (Large and Yeager 2008)' 
    252             CASE( np_COARE_3p0 )   ;   WRITE(numout,*) '         "COARE 3.0" algorithm   (Fairall et al. 2003)' 
    253             CASE( np_COARE_3p5 )   ;   WRITE(numout,*) '         "COARE 3.5" algorithm   (Edson et al. 2013)' 
    254             CASE( np_ECMWF     )   ;   WRITE(numout,*) '         "ECMWF" algorithm       (IFS cycle 31)' 
    255             END SELECT 
    256             WRITE(numout,*) 
    257          ENDIF 
    258       ENDIF 
    259  
     273      !!--------------------------------------------------------------------- 
     274      ! 
    260275      CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step 
    261  
     276      ! 
    262277      !                                            ! compute the surface ocean fluxes using bulk formulea 
    263278      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce( kt, sf, sst_m, ssu_m, ssv_m ) 
    … …  
    265280#if defined key_cice 
    266281      IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN 
    267          qlw_ice(:,:,1)   = sf(jp_qlw)%fnow(:,:,1) 
    268          qsr_ice(:,:,1)   = sf(jp_qsr)%fnow(:,:,1) 
     282         qlw_ice(:,:,1)   = sf(jp_qlw )%fnow(:,:,1) 
     283         qsr_ice(:,:,1)   = sf(jp_qsr )%fnow(:,:,1) 
    269284         tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1) 
    270285         qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1) 
    … …  
    398413         &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu ) 
    399414      CASE DEFAULT 
    400          CALL ctl_stop( 'STOP', 'sbc_blk: non-existing bulk formula selected' ) 
     415         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' ) 
    401416      END SELECT 
    402417 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r6723 r7163  
    260260      IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) 
    261261      ! 
    262       CALL ice_run                     ! set some ice run parameters 
     262      CALL lim_run_init                ! set some ice run parameters 
    263263      ! 
    264264      !                                ! Allocate the ice arrays 
    … …  
    323323 
    324324 
    325    SUBROUTINE ice_run 
     325   SUBROUTINE lim_run_init 
    326326      !!------------------------------------------------------------------- 
    327       !!                  ***  ROUTINE ice_run *** 
     327      !!                  ***  ROUTINE lim_run_init *** 
    328328      !! 
    329329      !! ** Purpose :   Definition some run parameter for ice model 
    … …  
    350350      IF(lwp) THEN                        ! control print 
    351351         WRITE(numout,*) 
    352          WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice' 
    353          WRITE(numout,*) ' ~~~~~~' 
    354          WRITE(numout,*) '   number of ice  categories                               = ', jpl 
    355          WRITE(numout,*) '   number of ice  layers                                   = ', nlay_i 
    356          WRITE(numout,*) '   number of snow layers                                   = ', nlay_s 
    357          WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn 
    358          WRITE(numout,*) '   maximum ice concentration for NH                        = ', rn_amax_n 
    359          WRITE(numout,*) '   maximum ice concentration for SH                        = ', rn_amax_s 
    360          WRITE(numout,*) '   Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb 
    361          WRITE(numout,*) '   Output   heat/salt budget or not          ln_limdiaout  = ', ln_limdiaout 
    362          WRITE(numout,*) '   control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_icectl 
    363          WRITE(numout,*) '   i-index for control prints (ln_icectl=true)             = ', iiceprt 
    364          WRITE(numout,*) '   j-index for control prints (ln_icectl=true)             = ', jiceprt 
     352         WRITE(numout,*) 'lim_run_init : ice share parameters for dynamics/advection/thermo of sea-ice' 
     353         WRITE(numout,*) '~~~~~~~~~~~~' 
     354         WRITE(numout,*) '   Namelist namicerun' 
     355         WRITE(numout,*) '      number of ice  categories                               = ', jpl 
     356         WRITE(numout,*) '      number of ice  layers                                   = ', nlay_i 
     357         WRITE(numout,*) '      number of snow layers                                   = ', nlay_s 
     358         WRITE(numout,*) '      switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn 
     359         WRITE(numout,*) '      maximum ice concentration for NH                        = ', rn_amax_n 
     360         WRITE(numout,*) '      maximum ice concentration for SH                        = ', rn_amax_s 
     361         WRITE(numout,*) '      Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb 
     362         WRITE(numout,*) '      Output   heat/salt budget or not          ln_limdiaout  = ', ln_limdiaout 
     363         WRITE(numout,*) '      control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_icectl 
     364         WRITE(numout,*) '      i-index for control prints (ln_icectl=true)             = ', iiceprt 
     365         WRITE(numout,*) '      j-index for control prints (ln_icectl=true)             = ', jiceprt 
    365366      ENDIF 
    366367      ! 
    … …  
    377378#endif 
    378379      ! 
    379    END SUBROUTINE ice_run 
     380   END SUBROUTINE lim_run_init 
    380381 
    381382 
    … …  
    407408      IF(lwp) THEN                        ! control print 
    408409         WRITE(numout,*) 
    409          WRITE(numout,*) 'ice_itd : ice cat distribution' 
    410          WRITE(numout,*) ' ~~~~~~' 
    411          WRITE(numout,*) '   shape of ice categories distribution                     nn_catbnd = ', nn_catbnd 
    412          WRITE(numout,*) '   mean ice thickness in the domain (used if nn_catbnd=2)   rn_himean = ', rn_himean 
     410         WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 
     411         WRITE(numout,*) '~~~~~~~~~~~~' 
     412         WRITE(numout,*) '   Namelist namiceitd' 
     413         WRITE(numout,*) '      shape of ice categories distribution                     nn_catbnd = ', nn_catbnd 
     414         WRITE(numout,*) '      mean ice thickness in the domain (used if nn_catbnd=2)   rn_himean = ', rn_himean 
    413415      ENDIF 
    414416      ! 
    … …  
    416418      !- Thickness categories boundaries 
    417419      !---------------------------------- 
    418       IF(lwp) WRITE(numout,*) 
    419       IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 
    420       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    421420      ! 
    422421      hi_max(:) = 0._wp 
    … …  
    450449      hi_max(jpl) = 99._wp          ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 
    451450      ! 
    452       IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 
    453       IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) 
     451      IF(lwp) WRITE(numout,*) 
     452      IF(lwp) WRITE(numout,*) '      Thickness category boundaries ' 
     453      IF(lwp) WRITE(numout,*) '         hi_max ', hi_max(0:jpl) 
    454454      ! 
    455455   END SUBROUTINE lim_itd_init 
    … …  
    588588      afx_dyn(:,:) = 0._wp   ;   afx_thd(:,:) = 0._wp 
    589589      ! 
    590       diag_heat(:,:) = 0._wp ;   diag_smvi(:,:) = 0._wp ; 
    591       diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp ; 
     590      diag_heat(:,:) = 0._wp ;   diag_smvi(:,:) = 0._wp 
     591      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp 
    592592      ! 
    593593   END SUBROUTINE sbc_lim_diag0 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r6723 r7163  
    3636   USE sbcice_lim_2   ! surface boundary condition: LIM 2.0 sea-ice model 
    3737   USE sbcice_cice    ! surface boundary condition: CICE    sea-ice model 
    38    USE sbccpl         ! surface boundary condition: coupled florulation 
     38   USE sbccpl         ! surface boundary condition: coupled formulation 
    3939   USE cpl_oasis3     ! OASIS routines for coupling 
    4040   USE sbcssr         ! surface boundary condition: sea surface restoring 
    … …  
    8383      !!              - nsbc: type of sbc 
    8484      !!---------------------------------------------------------------------- 
    85       INTEGER ::   icpt   ! local integer 
    86       !! 
    87       NAMELIST/namsbc/ nn_fsbc  , ln_ana   , ln_flx, ln_blk, ln_cpl   , ln_mixcpl,        & 
    88          &             nn_components      , nn_limflx  ,                                  & 
    89          &             ln_traqsr, ln_dm2dc ,                                              & 
    90          &             nn_ice   , nn_ice_embd,                                            & 
    91          &             ln_rnf   , ln_ssr   , ln_isf   , nn_fwb    , ln_apr_dyn,           & 
    92          &             ln_wave  ,                                                         & 
     85      INTEGER ::   ios, icpt                         ! local integer 
     86      LOGICAL ::   ll_purecpl, ll_opa, ll_not_nemo   ! local logical 
     87      !! 
     88      NAMELIST/namsbc/ nn_fsbc  ,                                                    & 
     89         &             ln_ana   , ln_flx   , ln_blk       ,                          & 
     90         &             ln_cpl   , ln_mixcpl, nn_components, nn_limflx,               & 
     91         &             nn_ice   , nn_ice_embd,                                       & 
     92         &             ln_traqsr, ln_dm2dc ,                                         & 
     93         &             ln_rnf   , nn_fwb   , ln_ssr       , ln_isf   , ln_apr_dyn,   & 
     94         &             ln_wave  ,                                                    & 
    9395         &             nn_lsm 
    94       INTEGER  ::   ios 
    95       INTEGER  ::   ierr, ierr0, ierr1, ierr2, ierr3, jpm 
    96       LOGICAL  ::   ll_purecpl 
    9796      !!---------------------------------------------------------------------- 
    9897      ! 
    … …  
    103102      ENDIF 
    104103      ! 
    105       REWIND( numnam_ref )              ! Namelist namsbc in reference namelist : Surface boundary 
     104      !                       !**  read Surface Module namelist 
     105      REWIND( numnam_ref )          !* Namelist namsbc in reference namelist : Surface boundary 
    106106      READ  ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901) 
    107107901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp ) 
    108108      ! 
    109       REWIND( numnam_cfg )              ! Namelist namsbc in configuration namelist : Parameters of the run 
     109      REWIND( numnam_cfg )          !* Namelist namsbc in configuration namelist : Parameters of the run 
    110110      READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 
    111111902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp ) 
    112112      IF(lwm) WRITE( numond, namsbc ) 
    113113      ! 
    114       !                          ! overwrite namelist parameter using CPP key information 
     114      !                             !* overwrite namelist parameter using CPP key information 
    115115      IF( Agrif_Root() ) THEN                ! AGRIF zoom 
    116116         IF( lk_lim2 )   nn_ice      = 2 
    … …  
    123123      ENDIF 
    124124      ! 
    125       IF(lwp) THEN               ! Control print 
    126          WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)' 
    127          WRITE(numout,*) '           frequency update of sbc (and ice)             nn_fsbc     = ', nn_fsbc 
    128          WRITE(numout,*) '           Type of air-sea fluxes : ' 
    129          WRITE(numout,*) '              analytical formulation                     ln_ana        = ', ln_ana 
    130          WRITE(numout,*) '              flux       formulation                     ln_flx        = ', ln_flx 
    131          WRITE(numout,*) '              bulk       formulation                     ln_blk        = ', ln_blk 
    132          WRITE(numout,*) '           Type of coupling (Ocean/Ice/Atmosphere) : ' 
    133          WRITE(numout,*) '              ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl 
    134          WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl     = ', ln_mixcpl 
    135          WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis      = ', lk_oasis 
    136          WRITE(numout,*) '              components of your executable              nn_components = ', nn_components 
    137          WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx     = ', nn_limflx 
    138          WRITE(numout,*) '           Sea-ice : ' 
    139          WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice        = ', nn_ice 
    140          WRITE(numout,*) '              ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd   = ', nn_ice_embd 
    141          WRITE(numout,*) '           Misc. options of sbc : ' 
    142          WRITE(numout,*) '              Light penetration in temperature Eq.       ln_traqsr     = ', ln_traqsr 
    143          WRITE(numout,*) '                 daily mean to diurnal cycle qsr            ln_dm2dc   = ', ln_dm2dc 
    144          WRITE(numout,*) '              Sea Surface Restoring on SST and/or SSS    ln_ssr        = ', ln_ssr 
    145          WRITE(numout,*) '              FreshWater Budget control  (=0/1/2)        nn_fwb        = ', nn_fwb 
    146          WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn    = ', ln_apr_dyn 
    147          WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf        = ', ln_rnf 
    148          WRITE(numout,*) '              iceshelf formulation                       ln_isf        = ', ln_isf 
    149          WRITE(numout,*) '              closed sea (=0/1) (set in namdom)          nn_closea     = ', nn_closea 
    150          WRITE(numout,*) '              nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm 
    151          WRITE(numout,*) '              surface wave                               ln_wave       = ', ln_wave 
    152       ENDIF 
    153       ! 
    154       IF(lwp) THEN 
    155          WRITE(numout,*) 
    156          SELECT CASE ( nn_limflx )        ! LIM3 Multi-category heat flux formulation 
    157          CASE ( -1 )   ;   WRITE(numout,*) '   LIM3: use per-category fluxes (nn_limflx = -1) ' 
    158          CASE ( 0  )   ;   WRITE(numout,*) '   LIM3: use average per-category fluxes (nn_limflx = 0) ' 
    159          CASE ( 1  )   ;   WRITE(numout,*) '   LIM3: use average then redistribute per-category fluxes (nn_limflx = 1) ' 
    160          CASE ( 2  )   ;   WRITE(numout,*) '   LIM3: Redistribute a single flux over categories (nn_limflx = 2) ' 
     125      IF(lwp) THEN                  !* Control print 
     126         WRITE(numout,*) '   Namelist namsbc (partly overwritten with CPP key setting)' 
     127         WRITE(numout,*) '      frequency update of sbc (and ice)             nn_fsbc       = ', nn_fsbc 
     128         WRITE(numout,*) '      Type of air-sea fluxes : ' 
     129         WRITE(numout,*) '         analytical formulation                     ln_ana        = ', ln_ana 
     130         WRITE(numout,*) '         flux       formulation                     ln_flx        = ', ln_flx 
     131         WRITE(numout,*) '         bulk       formulation                     ln_blk        = ', ln_blk 
     132         WRITE(numout,*) '      Type of coupling (Ocean/Ice/Atmosphere) : ' 
     133         WRITE(numout,*) '         ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl 
     134         WRITE(numout,*) '         mixed forced-coupled     formulation       ln_mixcpl     = ', ln_mixcpl 
     135!!gm  lk_oasis is controlled by key_oasis3  ===>>>  It shoud be removed from the namelist  
     136         WRITE(numout,*) '         OASIS coupling (with atm or sas)           lk_oasis      = ', lk_oasis 
     137         WRITE(numout,*) '         components of your executable              nn_components = ', nn_components 
     138         WRITE(numout,*) '         Multicategory heat flux formulation (LIM3) nn_limflx     = ', nn_limflx 
     139         WRITE(numout,*) '      Sea-ice : ' 
     140         WRITE(numout,*) '         ice management in the sbc (=0/1/2/3)       nn_ice        = ', nn_ice 
     141         WRITE(numout,*) '         ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd   = ', nn_ice_embd 
     142         WRITE(numout,*) '      Misc. options of sbc : ' 
     143         WRITE(numout,*) '         Light penetration in temperature Eq.       ln_traqsr     = ', ln_traqsr 
     144         WRITE(numout,*) '            daily mean to diurnal cycle qsr            ln_dm2dc   = ', ln_dm2dc 
     145         WRITE(numout,*) '         Sea Surface Restoring on SST and/or SSS    ln_ssr        = ', ln_ssr 
     146         WRITE(numout,*) '         FreshWater Budget control  (=0/1/2)        nn_fwb        = ', nn_fwb 
     147         WRITE(numout,*) '         Patm gradient added in ocean & ice Eqs.    ln_apr_dyn    = ', ln_apr_dyn 
     148         WRITE(numout,*) '         runoff / runoff mouths                     ln_rnf        = ', ln_rnf 
     149         WRITE(numout,*) '         iceshelf formulation                       ln_isf        = ', ln_isf 
     150         WRITE(numout,*) '         closed sea (=0/1) (set in namdom)          nn_closea     = ', nn_closea 
     151         WRITE(numout,*) '         nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm 
     152         WRITE(numout,*) '         surface wave                               ln_wave       = ', ln_wave 
     153      ENDIF 
     154      ! 
     155      !                       !**  check option consistency 
     156      ! 
     157      IF(lwp) WRITE(numout,*)       !* Single / Multi - executable (NEMO / OPA+SAS)  
     158      SELECT CASE( nn_components ) 
     159      CASE( jp_iam_nemo ) 
     160         IF(lwp) WRITE(numout,*) '   NEMO configured as a single executable (i.e. including both OPA and Surface module'  
     161      CASE( jp_iam_opa  ) 
     162         IF(lwp) WRITE(numout,*) '   Multi executable configuration. Here, OPA component' 
     163         IF( .NOT.lk_oasis )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 
     164         IF( ln_cpl        )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA'   ) 
     165         IF( ln_mixcpl     )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 
     166      CASE( jp_iam_sas  ) 
     167         IF(lwp) WRITE(numout,*) '   Multi executable configuration. Here, SAS component' 
     168         IF( .NOT.lk_oasis )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 
     169         IF( ln_mixcpl     )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 
     170      CASE DEFAULT 
     171         CALL ctl_stop( 'sbc_init : unsupported value for nn_components' ) 
     172      END SELECT 
     173      !                             !* coupled options 
     174      IF( ln_cpl ) THEN 
     175         IF( .NOT. lk_oasis )   CALL ctl_stop( 'sbc_init : coupled mode with an atmosphere model (ln_cpl=T)',   & 
     176            &                                  '           required to defined key_oasis3' ) 
     177      ENDIF 
     178      IF( ln_mixcpl ) THEN 
     179         IF( .NOT. lk_oasis )   CALL ctl_stop( 'sbc_init : mixed forced-coupled mode (ln_mixcpl=T) ',   & 
     180            &                                  '           required to defined key_oasis3' ) 
     181         IF( .NOT.ln_cpl    )   CALL ctl_stop( 'sbc_init : mixed forced-coupled mode (ln_mixcpl=T) requires ln_cpl = T' ) 
     182         IF( nn_components /= jp_iam_nemo )    & 
     183            &                   CALL ctl_stop( 'sbc_init : the mixed forced-coupled mode (ln_mixcpl=T) ',   & 
     184            &                                   '          not yet working with sas-opa coupling via oasis' ) 
     185      ENDIF 
     186      !                             !* sea-ice 
     187      SELECT CASE( nn_ice ) 
     188      CASE( 0 )                        !- no ice in the domain 
     189      CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model)   
     190      CASE( 2 )                        !- LIM2 ice model 
     191         IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : LIM2 sea-ice model requires ln_blk or ln_cpl = T' ) 
     192      CASE( 3 )                        !- LIM3 ice model 
     193         IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : LIM3 sea-ice model requires ln_blk or ln_cpl = T' ) 
     194         IF( nn_ice_embd == 0            )   CALL ctl_stop( 'sbc_init : LIM3 sea-ice models require nn_ice_embd = 1 or 2' ) 
     195      CASE( 4 )                        !- CICE ice model 
     196         IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl = T' ) 
     197         IF( nn_ice_embd == 0            )   CALL ctl_stop( 'sbc_init : CICE sea-ice models require nn_ice_embd = 1 or 2' ) 
     198         IF( lk_agrif                    )   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 
     199      CASE DEFAULT                     !- not supported 
     200      END SELECT 
     201      ! 
     202      IF( nn_ice == 3 ) THEN           !- LIM3 case: multi-category flux option 
     203         IF(lwp) WRITE(numout,*) 
     204         SELECT CASE( nn_limflx )         ! LIM3 Multi-category heat flux formulation 
     205         CASE ( -1 )    
     206            IF(lwp) WRITE(numout,*) '   LIM3: use per-category fluxes (nn_limflx = -1) ' 
     207            IF( ln_cpl )   CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
     208         CASE ( 0  )    
     209            IF(lwp) WRITE(numout,*) '   LIM3: use average per-category fluxes (nn_limflx = 0) ' 
     210         CASE ( 1  ) 
     211            IF(lwp) WRITE(numout,*) '   LIM3: use average then redistribute per-category fluxes (nn_limflx = 1) ' 
     212            IF( ln_cpl )   CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
     213         CASE ( 2  ) 
     214            IF(lwp) WRITE(numout,*) '   LIM3: Redistribute a single flux over categories (nn_limflx = 2) ' 
     215            IF( .NOT.ln_cpl )   CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 
     216         CASE DEFAULT 
     217            CALL ctl_stop( 'sbcmod: LIM3 option, nn_limflx, should be between -1 and 2' ) 
    161218         END SELECT 
    162       ENDIF 
    163       ! 
    164       IF( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis )   & 
    165          &      CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 
    166       IF( nn_components == jp_iam_opa .AND. ln_cpl )   & 
    167          &      CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' ) 
    168       IF( nn_components == jp_iam_opa .AND. ln_mixcpl )   & 
    169          &      CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 
    170       IF( ln_cpl .AND. .NOT. lk_oasis )    & 
    171          &      CALL ctl_stop( 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' ) 
    172       IF( ln_mixcpl .AND. .NOT. lk_oasis )    & 
    173          &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' ) 
    174       IF( ln_mixcpl .AND. .NOT. ln_cpl )    & 
    175          &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' ) 
    176       IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo )    & 
    177          &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' ) 
    178  
    179       !                              ! allocate sbc arrays 
     219      ELSE                             ! other sea-ice model 
     220         IF( nn_limflx >= 0  )   CALL ctl_warn( 'sbc_init : multi-category flux option (nn_limflx) only available in LIM3' ) 
     221      ENDIF 
     222      ! 
     223      !                       !**  allocate and set required variables 
     224      ! 
     225      !                             !* allocate sbc arrays 
    180226      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'sbc_init : unable to allocate sbc_oce arrays' ) 
    181  
    182       !                          ! Checks: 
    183       IF( .NOT. ln_isf ) THEN                      ! variable initialisation if no ice shelf 
     227      ! 
     228      IF( .NOT.ln_isf ) THEN        !* No ice-shelf in the domain : allocate and set to zero 
    184229         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' ) 
    185          fwfisf  (:,:)   = 0.0_wp ; fwfisf_b  (:,:)   = 0.0_wp 
    186          risf_tsc(:,:,:) = 0.0_wp ; risf_tsc_b(:,:,:) = 0.0_wp 
     230         fwfisf  (:,:)   = 0._wp   ;   risf_tsc  (:,:,:) = 0._wp 
     231         fwfisf_b(:,:)   = 0._wp   ;   risf_tsc_b(:,:,:) = 0._wp 
    187232      END IF 
    188       IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa )   fr_i(:,:) = 0._wp    ! no ice in the domain, ice fraction is always zero 
    189  
    190       sfx(:,:) = 0._wp                             ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero) 
    191       !                                            ! only if sea-ice is present 
    192  
    193       fmmflx(:,:) = 0._wp                          ! freezing-melting array initialisation 
    194  
    195       taum(:,:) = 0._wp                            ! Initialise taum for use in gls in case of reduced restart 
    196  
    197       !                                            ! restartability 
    198       IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk .OR. ln_cpl ) )   & 
    199          &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 
    200       IF( nn_ice == 4 .AND. .NOT.( ln_blk .OR. ln_cpl ) )   & 
    201          &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk or ln_cpl' ) 
    202       IF( nn_ice == 4 .AND. lk_agrif )   & 
    203          &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) 
    204       IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   & 
    205          &   CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' ) 
    206       IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) )   & 
    207          &   WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 
    208       IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
    209          &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
    210       IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) )   & 
    211          &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 
    212  
    213       IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    214  
    215       IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk ) .AND. nn_components /= jp_iam_opa )   & 
    216          &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or the bulk formulation' ) 
    217  
    218       !                          ! Choice of the Surface Boudary Condition (set nsbc) 
    219       ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl 
    220       ! 
     233      IF( nn_ice == 0 ) THEN        !* No sea-ice in the domain : ice fraction is always zero 
     234         IF( nn_components /= jp_iam_opa )   fr_i(:,:) = 0._wp    ! except for OPA in SAS-OPA coupled case 
     235      ENDIF 
     236      ! 
     237      sfx   (:,:) = 0._wp           !* salt flux due to freezing/melting 
     238      fmmflx(:,:) = 0._wp           !* freezing minus melting flux 
     239 
     240      taum(:,:) = 0._wp             !* wind stress module (needed in GLS in case of reduced restart) 
     241 
     242 
     243      IF( ln_dm2dc ) THEN           !* daily mean to diurnal cycle 
     244         nday_qsr = -1   ! allow initialization at the 1st call 
     245         IF( .NOT.( ln_flx .OR. ln_blk ) .AND. nn_components /= jp_iam_opa )   & 
     246            &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires a flux or bulk formulation' ) 
     247      ENDIF 
     248 
     249      !                             !* Choice of the Surface Boudary Condition (set nsbc) 
     250      ! 
     251      ll_purecpl  = ln_cpl .AND. .NOT.ln_mixcpl 
     252      ll_opa      = nn_components == jp_iam_opa 
     253      ll_not_nemo = nn_components /= jp_iam_nemo 
    221254      icpt = 0 
     255      ! 
    222256      IF( ln_ana          ) THEN   ;   nsbc = jp_ana     ; icpt = icpt + 1   ;   ENDIF       ! analytical           formulation 
    223257      IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation 
    … …  
    225259      IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation 
    226260      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                        ;   ENDIF       ! GYRE analytical      formulation 
    227       IF( nn_components == jp_iam_opa )   & 
    228          &                  THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module 
    229       ! 
    230       IF( icpt /= 1 )    CALL ctl_stop( 'sbc_init: choose ONE and only ONE sbc option' ) 
    231       ! 
    232       IF(lwp) THEN 
     261      IF( ll_opa          ) THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module 
     262      ! 
     263      IF( icpt /= 1 )    CALL ctl_stop( 'sbc_init : choose ONE and only ONE sbc option' ) 
     264      ! 
     265      IF(lwp) THEN                     !- print the choice of surface flux formulation 
    233266         WRITE(numout,*) 
    234267         SELECT CASE( nsbc ) 
    235          CASE( jp_gyre    )   ;   WRITE(numout,*) '   GYRE analytical formulation' 
    236          CASE( jp_ana     )   ;   WRITE(numout,*) '   analytical formulation' 
    237          CASE( jp_flx     )   ;   WRITE(numout,*) '   flux formulation' 
    238          CASE( jp_blk     )   ;   WRITE(numout,*) '   bulk formulation' 
    239          CASE( jp_purecpl )   ;   WRITE(numout,*) '   pure coupled formulation' 
    240          CASE( jp_none    )   ;   WRITE(numout,*) '   OPA coupled to SAS via oasis' 
    241             IF( ln_mixcpl )       WRITE(numout,*) '       + forced-coupled mixed formulation' 
     268         CASE( jp_gyre    )   ;   WRITE(numout,*) '      ===>>   GYRE analytical formulation' 
     269         CASE( jp_ana     )   ;   WRITE(numout,*) '      ===>>   analytical formulation' 
     270         CASE( jp_flx     )   ;   WRITE(numout,*) '      ===>>   flux formulation' 
     271         CASE( jp_blk     )   ;   WRITE(numout,*) '      ===>>   bulk formulation' 
     272         CASE( jp_purecpl )   ;   WRITE(numout,*) '      ===>>   pure coupled formulation' 
     273!!gm abusive use of jp_none ??   ===>>> need to be check and changed by adding a jp_sas parameter 
     274         CASE( jp_none    )   ;   WRITE(numout,*) '      ===>>   OPA coupled to SAS via oasis' 
     275            IF( ln_mixcpl )       WRITE(numout,*) '                  + forced-coupled mixed formulation' 
    242276         END SELECT 
    243          IF( nn_components/= jp_iam_nemo )  & 
    244             &                     WRITE(numout,*) '       + OASIS coupled SAS' 
    245       ENDIF 
    246       ! 
    247       IF( lk_oasis )   CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step 
    248       !                                             !                                            (2) the use of nn_fsbc 
     277         IF( ll_not_nemo  )       WRITE(numout,*) '                  + OASIS coupled SAS' 
     278      ENDIF 
     279      ! 
     280      !                             !* OASIS initialization 
     281      ! 
     282      IF( lk_oasis )   CALL sbc_cpl_init( nn_ice )   ! Must be done before: (1) first time step 
     283      !                                              !                      (2) the use of nn_fsbc 
    249284      !     nn_fsbc initialization if OPA-SAS coupling via OASIS 
    250       !     sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 
     285      !     SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 
    251286      IF( nn_components /= jp_iam_nemo ) THEN 
    252287         IF( nn_components == jp_iam_opa )   nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt) 
    … …  
    260295      ENDIF 
    261296      ! 
     297      !                             !* check consistency between model timeline and nn_fsbc 
    262298      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   & 
    263299          MOD( nstock             , nn_fsbc) /= 0 ) THEN 
    264          WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   & 
     300         WRITE(ctmp1,*) 'sbc_init : experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   & 
    265301            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 
    266302         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 
    … …  
    268304      ! 
    269305      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   & 
    270          &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
    271       ! 
    272       IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   & 
    273          &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
    274       ! 
    275                           CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
    276       ! 
    277       IF( ln_ssr      )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
    278       ! 
    279                           CALL sbc_rnf_init               ! Runof initialisation 
    280       ! 
    281       IF( nn_ice == 3 )   CALL sbc_lim_init               ! LIM3 initialisation 
    282       ! 
    283       IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
     306         &  CALL ctl_warn( 'sbc_init : nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
     307      ! 
     308      IF( ln_dm2dc .AND. NINT(rday) / ( nn_fsbc * NINT(rdt) ) < 8  )   & 
     309         &   CALL ctl_warn( 'sbc_init : diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
     310      ! 
     311    
     312      !                       !**  associated modules : initialization 
     313      ! 
     314                          CALL sbc_ssm_init            ! Sea-surface mean fields initialization 
     315      ! 
     316      IF( ln_blk      )   CALL sbc_blk_init            ! bulk formulae initialization 
     317 
     318      IF( ln_ssr      )   CALL sbc_ssr_init            ! Sea-Surface Restoring initialization 
     319      ! 
     320                          CALL sbc_rnf_init            ! Runof initialization 
     321      ! 
     322      IF( nn_ice == 3 )   CALL sbc_lim_init            ! LIM3 initialization 
     323      ! 
     324      IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )   ! CICE initialization 
    284325      ! 
    285326   END SUBROUTINE sbc_init 
    … …  
    337378      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    338379      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx) 
    339       CASE( jp_gyre    )   ;   CALL sbc_gyre  ( kt )                     ! analytical formulation : GYRE configuration 
    340       CASE( jp_ana     )   ;   CALL sbc_ana   ( kt )                     ! analytical formulation : uniform sbc 
    341       CASE( jp_flx     )   ;   CALL sbc_flx   ( kt )                     ! flux formulation 
     380      CASE( jp_gyre    )   ;   CALL sbc_gyre   ( kt )                    ! analytical formulation : GYRE configuration 
     381      CASE( jp_ana     )   ;   CALL sbc_ana    ( kt )                    ! analytical formulation : uniform sbc 
     382      CASE( jp_flx     )   ;   CALL sbc_flx    ( kt )                    ! flux formulation 
    342383      CASE( jp_blk     ) 
    343384         IF( ll_sas    )       CALL sbc_cpl_rcv( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r6460 r7163  
    279279      IF(lwp) THEN 
    280280         WRITE(numout,*) 
    281          WRITE(numout,*) 'sbc_rnf : runoff ' 
    282          WRITE(numout,*) '~~~~~~~ ' 
     281         WRITE(numout,*) 'sbc_rnf_init : runoff ' 
     282         WRITE(numout,*) '~~~~~~~~~~~~ ' 
    283283         WRITE(numout,*) '   Namelist namsbc_rnf' 
    284284         WRITE(numout,*) '      specific river mouths treatment            ln_rnf_mouth = ', ln_rnf_mouth 
    … …  
    296296         IF(lwp) WRITE(numout,*) '          runoffs inflow read in a file' 
    297297         IF( ierror > 0 ) THEN 
    298             CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' )   ;   RETURN 
     298            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_rnf structure' )   ;   RETURN 
    299299         ENDIF 
    300300         ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1)   ) 
    301301         IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 
    302          CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' ) 
     302         CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf', no_print ) 
    303303      ENDIF 
    304304      ! 
    … …  
    312312         ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   ) 
    313313         IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) ) 
    314          CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 
     314         CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf', no_print ) 
    315315      ENDIF 
    316316      ! 
    … …  
    324324         ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   ) 
    325325         IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) ) 
    326          CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 
     326         CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf', no_print ) 
    327327      ENDIF 
    328328      ! 
    … …  
    452452            DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1 
    453453            END DO 
    454             IF( ln_sco )   CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' ) 
     454            IF( ln_sco )   CALL ctl_warn( 'sbc_rnf_init: number of levels over which Kz is increased is computed for zco...' ) 
    455455         ENDIF 
    456456         IF(lwp) WRITE(numout,*) 
    … …  
    499499      ! 
    500500      IF(lwp) WRITE(numout,*) 
    501       IF(lwp) WRITE(numout,*) 'rnf_mouth : river mouth mask' 
    502       IF(lwp) WRITE(numout,*) '~~~~~~~~~ ' 
     501      IF(lwp) WRITE(numout,*) '   rnf_mouth : river mouth mask' 
     502      IF(lwp) WRITE(numout,*) '   ~~~~~~~~~ ' 
    503503      ! 
    504504      cl_rnfile = TRIM( cn_dir )//TRIM( sn_cnf%clname ) 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r6723 r7163  
    221221            ! 
    222222            IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN      ! nn_fsbc has changed between 2 runs 
    223                IF(lwp) WRITE(numout,*) '~~~~~~~   restart with a change in the frequency of mean ',   & 
    224                   &                    'from ', zf_sbc, ' to ', nn_fsbc  
     223               IF(lwp) WRITE(numout,*) '   restart with a change in the frequency of mean from ', zf_sbc, ' to ', nn_fsbc  
    225224               zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc  
    226225               ssu_m(:,:) = zcoef * ssu_m(:,:)  
    … …  
    232231               frq_m(:,:) = zcoef * frq_m(:,:) 
    233232            ELSE 
    234                IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields read in the ocean restart file' 
     233               IF(lwp) WRITE(numout,*) '   mean fields read in the ocean restart file' 
    235234            ENDIF 
    236235         ENDIF 
    … …  
    239238      IF( .NOT. l_ssm_mean ) THEN   ! default initialisation. needed by lim_istate 
    240239         ! 
    241          IF(lwp) WRITE(numout,*) '          default initialisation of ss?_m arrays' 
     240         IF(lwp) WRITE(numout,*) '   default initialisation of ss._m arrays' 
    242241         ssu_m(:,:) = ub(:,:,1) 
    243242         ssv_m(:,:) = vb(:,:,1) 
    244243         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
    245          ELSE                    ;   sst_m(:,:) = tsn(:,:,1,jp_tem) 
     244         ELSE                   ;   sst_m(:,:) = tsn(:,:,1,jp_tem) 
    246245         ENDIF 
    247246         sss_m(:,:) = tsn  (:,:,1,jp_sal) 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r6140 r7163  
    199199         ! 
    200200         ! fill sf_sst with sn_sst and control print 
    201          CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' ) 
     201         CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr', no_print ) 
    202202         IF( sf_sst(1)%ln_tint )   ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 
    203203         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst data array' ) 
    … …  
    213213         ! 
    214214         ! fill sf_sss with sn_sss and control print 
    215          CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' ) 
     215         CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr', no_print ) 
    216216         IF( sf_sss(1)%ln_tint )   ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 
    217217         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' ) 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r6140 r7163  
    255255         WRITE(numout,*) 
    256256         SELECT CASE ( nadv ) 
    257          CASE( np_NO_adv  )   ;   WRITE(numout,*) '         NO T-S advection' 
    258          CASE( np_CEN     )   ;   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   & 
     257         CASE( np_NO_adv  )   ;   WRITE(numout,*) '      ===>>   NO T-S advection' 
     258         CASE( np_CEN     )   ;   WRITE(numout,*) '      ===>>   CEN      scheme is used. Horizontal order: ', nn_cen_h,   & 
    259259            &                                                                     ' Vertical   order: ', nn_cen_v 
    260          CASE( np_FCT     )   ;   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
     260         CASE( np_FCT     )   ;   WRITE(numout,*) '      ===>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
    261261            &                                                                      ' Vertical   order: ', nn_fct_v 
    262          CASE( np_FCT_zts )   ;   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 
    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' 
     262         CASE( np_FCT_zts )   ;   WRITE(numout,*) '      ===>>   use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 
     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/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

    r6691 r7163  
    728728               ! 
    729729               IF( tmask(ji,jj,jk+1) == 0._wp) THEN   ! Switch to second order centered at bottom 
    730                   zwd (ji,jj,jk) = 1._wp 
    731                   zwi (ji,jj,jk) = 0._wp 
    732                   zws (ji,jj,jk) = 0._wp 
    733                   zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )     
     730                  zwd (ji,jj,jk) = 2._wp 
     731                  zwi (ji,jj,jk) = 0._wp     ! 1  ici ou à l'autre 
     732                  zws (ji,jj,jk) = 0._wp     !    car 1 dans la diag inferieur au fond et superior en surf 
     733                  zwrm(ji,jj,jk) = 3._wp * pt_in(ji,jj,jk)   
    734734               ENDIF 
    735735            END DO 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    r6140 r7163  
    308308         WRITE(numout,*) 
    309309         IF( ln_mle ) THEN 
    310             WRITE(numout,*) '   Mixed Layer Eddy induced transport added to tracer advection' 
    311             IF( nn_mle == 0 )   WRITE(numout,*) '   Fox-Kemper et al 2010 formulation' 
    312             IF( nn_mle == 1 )   WRITE(numout,*) '   New formulation' 
     310            WRITE(numout,*) '      ===>>   Mixed Layer Eddy induced transport added to tracer advection' 
     311            IF( nn_mle == 0 )   WRITE(numout,*) '              Fox-Kemper et al 2010 formulation' 
     312            IF( nn_mle == 1 )   WRITE(numout,*) '              New formulation' 
    313313         ELSE 
    314             WRITE(numout,*) '   Mixed Layer Eddy parametrisation NOT used' 
     314            WRITE(numout,*) '      ===>>   Mixed Layer Eddy parametrisation NOT used' 
    315315         ENDIF 
    316316      ENDIF 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r6140 r7163  
    176176            ! fill sf_chl with sn_chl and control print 
    177177            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   & 
    178                &          'bottom temperature boundary condition', 'nambbc' ) 
     178               &          'bottom temperature boundary condition', 'nambbc', no_print ) 
    179179 
    180180            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r6140 r7163  
    519519         WRITE(numout,*) 'tra_bbl_init : bottom boundary layer initialisation' 
    520520         WRITE(numout,*) '~~~~~~~~~~~~' 
    521          WRITE(numout,*) '       Namelist nambbl : set bbl parameters' 
    522          WRITE(numout,*) '          diffusive bbl (=1)   or not (=0)    nn_bbl_ldf = ', nn_bbl_ldf 
    523          WRITE(numout,*) '          advective bbl (=1/2) or not (=0)    nn_bbl_adv = ', nn_bbl_adv 
    524          WRITE(numout,*) '          diffusive bbl coefficient           rn_ahtbbl  = ', rn_ahtbbl, ' m2/s' 
    525          WRITE(numout,*) '          advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s' 
     521         WRITE(numout,*) '   Namelist nambbl : set bbl parameters' 
     522         WRITE(numout,*) '      diffusive bbl (=1)   or not (=0)    nn_bbl_ldf = ', nn_bbl_ldf 
     523         WRITE(numout,*) '      advective bbl (=1/2) or not (=0)    nn_bbl_adv = ', nn_bbl_adv 
     524         WRITE(numout,*) '      diffusive bbl coefficient           rn_ahtbbl  = ', rn_ahtbbl, ' m2/s' 
     525         WRITE(numout,*) '      advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s' 
    526526      ENDIF 
    527527 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r6140 r7163  
    192192         WRITE(numout,*) 
    193193         WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation' 
    194          WRITE(numout,*) '~~~~~~~~~~~' 
     194         WRITE(numout,*) '~~~~~~~~~~~~' 
    195195         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters' 
    196196         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r6352 r7163  
    110110         WRITE(numout,*) 
    111111         WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator' 
    112          WRITE(numout,*) '~~~~~~~~~~~' 
     112         WRITE(numout,*) '~~~~~~~~~~~~' 
    113113         WRITE(numout,*) '   Namelist namtra_ldf: already read in ldftra module' 
    114114         WRITE(numout,*) '      see ldf_tra_init report for lateral mixing parameters' 
    115          WRITE(numout,*) 
    116115      ENDIF 
    117116      !                                   ! use of lateral operator or not 
    … …  
    187186         WRITE(numout,*) 
    188187         SELECT CASE( nldf ) 
    189          CASE( np_no_ldf )   ;   WRITE(numout,*) '   NO lateral diffusion' 
    190          CASE( np_lap    )   ;   WRITE(numout,*) '   laplacian iso-level operator' 
    191          CASE( np_lap_i  )   ;   WRITE(numout,*) '   Rotated laplacian operator (standard)' 
    192          CASE( np_lap_it )   ;   WRITE(numout,*) '   Rotated laplacian operator (triad)' 
    193          CASE( np_blp    )   ;   WRITE(numout,*) '   bilaplacian iso-level operator' 
    194          CASE( np_blp_i  )   ;   WRITE(numout,*) '   Rotated bilaplacian operator (standard)' 
    195          CASE( np_blp_it )   ;   WRITE(numout,*) '   Rotated bilaplacian operator (triad)' 
     188         CASE( np_no_ldf )   ;   WRITE(numout,*) '      ===>>   NO lateral diffusion' 
     189         CASE( np_lap    )   ;   WRITE(numout,*) '      ===>>   laplacian iso-level operator' 
     190         CASE( np_lap_i  )   ;   WRITE(numout,*) '      ===>>   Rotated laplacian operator (standard)' 
     191         CASE( np_lap_it )   ;   WRITE(numout,*) '      ===>>   Rotated laplacian operator (triad)' 
     192         CASE( np_blp    )   ;   WRITE(numout,*) '      ===>>   bilaplacian iso-level operator' 
     193         CASE( np_blp_i  )   ;   WRITE(numout,*) '      ===>>   Rotated bilaplacian operator (standard)' 
     194         CASE( np_blp_it )   ;   WRITE(numout,*) '      ===>>   Rotated bilaplacian operator (triad)' 
    196195         END SELECT 
    197196      ENDIF 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r6403 r7163  
    406406            !                                        ! fill sf_chl with sn_chl and control print 
    407407            CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   & 
    408                &           'Solar penetration function of read chlorophyll', 'namtra_qsr' ) 
     408               &           'Solar penetration function of read chlorophyll', 'namtra_qsr' , no_print ) 
    409409         ENDIF 
    410410         IF( nqsr == np_RGB ) THEN                 ! constant Chl 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r6140 r7163  
    141141         WRITE(numout,*) 'tra_zdf_init : vertical tracer physics scheme' 
    142142         WRITE(numout,*) '~~~~~~~~~~~' 
    143          IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme' 
    144          IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme' 
     143         IF( nzdf ==  0 )   WRITE(numout,*) '      ===>>   Explicit time-splitting scheme' 
     144         IF( nzdf ==  1 )   WRITE(numout,*) '      ===>>   Implicit (euler backward) scheme' 
    145145      ENDIF 
    146146      ! 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90

    r6140 r7163  
    5757      IF(lwp) THEN                  ! control print 
    5858         WRITE(numout,*) 
    59          WRITE(numout,*) ' trd_init : Momentum/Tracers trends' 
    60          WRITE(numout,*) ' ~~~~~~~~~~' 
     59         WRITE(numout,*) 'trd_init : Momentum/Tracers trends' 
     60         WRITE(numout,*) '~~~~~~~~' 
    6161         WRITE(numout,*) '   Namelist namtrd : set trends parameters' 
    6262         WRITE(numout,*) '      global domain averaged dyn & tra trends   ln_glo_trd  = ', ln_glo_trd 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r6140 r7163  
    9999      ! 
    100100      IF( nn_timing == 1 )  CALL timing_start('zdf_bfr') 
    101       ! 
    102       IF( kt == nit000 .AND. lwp ) THEN 
    103          WRITE(numout,*) 
    104          WRITE(numout,*) 'zdf_bfr : Set bottom friction coefficient (non-linear case)' 
    105          WRITE(numout,*) '~~~~~~~~' 
    106       ENDIF 
    107101      ! 
    108102      IF( nn_bfr == 2 ) THEN                 ! quadratic bottom friction only 
    … …  
    259253      IF(lwp) WRITE(numout,*) 
    260254      IF(lwp) WRITE(numout,*) 'zdf_bfr_init : momentum bottom friction' 
    261       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 
     255      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    262256      IF(lwp) WRITE(numout,*) '   Namelist nam_bfr : set bottom friction parameters' 
    263257      ! 
    … …  
    266260      CASE( 0 ) 
    267261         IF(lwp) WRITE(numout,*) '      free-slip ' 
    268          bfrua(:,:) = 0.e0 
    269          bfrva(:,:) = 0.e0 
    270          tfrua(:,:) = 0.e0 
    271          tfrva(:,:) = 0.e0 
     262         bfrua(:,:) = 0._wp 
     263         bfrva(:,:) = 0._wp 
     264         tfrua(:,:) = 0._wp 
     265         tfrva(:,:) = 0._wp 
    272266         ! 
    273267      CASE( 1 ) 
    … …  
    321315         IF(lwp) WRITE(numout,*) '      log formulation   ln_bfr2d = ', ln_loglayer 
    322316         IF(lwp) WRITE(numout,*) '      bottom roughness  rn_bfrz0 [m] = ', rn_bfrz0 
    323          IF( rn_bfrz0<=0.e0 ) THEN 
     317         IF( rn_bfrz0 <= 0._wp ) THEN 
    324318            WRITE(ctmp1,*) '      bottom roughness must be strictly positive' 
    325319            CALL ctl_stop( ctmp1 ) 
    … …  
    336330            IF(lwp) WRITE(numout,*) '      log formulation   ln_tfr2d     = ', ln_loglayer 
    337331            IF(lwp) WRITE(numout,*) '      top roughness     rn_tfrz0 [m] = ', rn_tfrz0 
    338             IF( rn_tfrz0<=0.e0 ) THEN 
     332            IF( rn_tfrz0 <= 0._wp ) THEN 
    339333               WRITE(ctmp1,*) '      top roughness must be strictly positive' 
    340334               CALL ctl_stop( ctmp1 ) 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90

    r5836 r7163  
    6666      IF(lwp) THEN               !* Parameter print 
    6767         WRITE(numout,*) 
    68          WRITE(numout,*) 'zdf_init: vertical physics' 
     68         WRITE(numout,*) 'zdf_init : vertical physics' 
    6969         WRITE(numout,*) '~~~~~~~~' 
    7070         WRITE(numout,*) '   Namelist namzdf : set vertical mixing mixing parameters' 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r6497 r7163  
    558558         zmxlm(:,:,1) = rn_mxl0 
    559559      ENDIF 
     560       
     561!!gm  copy from GLS: 
     562!      ! Set surface roughness length 
     563!      SELECT CASE ( nn_z0_met ) 
     564!      ! 
     565!      CASE ( 0 )             ! Constant roughness           
     566!         zhsro(:,:) = rn_hsro 
     567!      CASE ( 1 )             ! Standard Charnock formula for surface roughness 
     568!         zhsro(:,:) = MAX(rsbc_zs1 * ustars2(:,:), rn_hsro) 
     569!  with:           rsbc_zs1  = rn_charn/grav 
     570!      CASE ( 2 )             ! Roughness formulae according to Rascle et al., Ocean Modelling (2008) 
     571!         zdep(:,:)  = 30.*TANH(2.*0.3/(28.*SQRT(MAX(ustars2(:,:),rsmall))))             ! Wave age (eq. 10) 
     572!         zhsro(:,:) = MAX(rsbc_zs2 * ustars2(:,:) * zdep(:,:)**1.5, rn_hsro) ! zhsro = rn_frac_hs * Hsw (eq. 11) 
     573!      ! 
     574!      END SELECT 
     575!!gm end 
     576 
     577 
     578 
    560579      ! 
    561580      DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2) 
    … …  
    788807 
    789808      IF( ln_mxl0 ) THEN 
     809         IF(lwp) WRITE(numout,*) 
    790810         IF(lwp) WRITE(numout,*) '   use a surface mixing length = F(stress) :   set rn_mxl0 = rmxl_min' 
    791811         rn_mxl0 = rmxl_min 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r6152 r7163  
    519519      IF(lwp) THEN                  ! control print 
    520520         WRITE(numout,*) 
    521          WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark' 
    522          WRITE(numout,*) '~~~~~~~ ' 
     521         WRITE(numout,*) 'nemo_ctl : Control prints & Benchmark' 
     522         WRITE(numout,*) '~~~~~~~~' 
    523523         WRITE(numout,*) '   Namelist namctl' 
    524524         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl 
    … …  
    545545      IF(lwp) THEN                  ! control print 
    546546         WRITE(numout,*) 
    547          WRITE(numout,*) 'namcfg  : configuration initialization through namelist read' 
    548          WRITE(numout,*) '~~~~~~~ ' 
     547         WRITE(numout,*) 'namcfg : configuration initialization through namelist read' 
     548         WRITE(numout,*) '~~~~~~ ' 
    549549         WRITE(numout,*) '   Namelist namcfg' 
    550550         WRITE(numout,*) '      configuration name                               cp_cfg  = ', TRIM(cp_cfg) 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r6140 r7163  
    110110      IF(lwp) THEN 
    111111         WRITE(numout,*) 
    112          WRITE(numout,*) 'trc_oce_rgb : Initialisation of the optical look-up table' 
    113          WRITE(numout,*) '~~~~~~~~~~~ ' 
     112         WRITE(numout,*) '   trc_oce_rgb : Initialisation of the optical look-up table' 
     113         WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    114114      ENDIF 
    115115      ! 
Note: See TracChangeset for help on using the changeset viewer.