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 7421 for branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

Ignore:
Timestamp:
2016-12-01T18:10:41+01:00 (8 years ago)
Author:
flavoni
Message:

#1811 merge dev_CNRS_MERATOR_2016 with dev_merge_2016 branch

Location:
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA
Files:
12 edited

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r6505 r7421  
    204204      !! 
    205205      !!     ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z). 
    206       !!         Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celcius, sa=35.5 g/kg 
     206      !!         Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celsius, sa=35.5 g/kg 
    207207      !! 
    208208      !!     ln_eos80 : polynomial EOS-80 equation of state is used for rho(t,s,z). 
    209       !!         Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celcius, sp=35.5 psu 
     209      !!         Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celsius, sp=35.5 psu 
    210210      !! 
    211211      !!     ln_seos : simplified equation of state 
    … …  
    221221      !!                TEOS-10 Manual, 2010 
    222222      !!---------------------------------------------------------------------- 
    223       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
     223      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    224224      !                                                               ! 2 : salinity               [psu] 
    225225      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd   ! in situ density            [-] 
    … …  
    316316      !! 
    317317      !!---------------------------------------------------------------------- 
    318       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius] 
     318      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
    319319      !                                                                ! 2 : salinity               [psu] 
    320320      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
    … …  
    481481      !! 
    482482      !!---------------------------------------------------------------------- 
    483       REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
     483      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    484484      !                                                           ! 2 : salinity               [psu] 
    485485      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m] 
    … …  
    907907      !! 
    908908      !!---------------------------------------------------------------------- 
    909       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celcius,psu] 
    910       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celcius-1,psu-1] 
     909      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celsius,psu] 
     910      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celsius-1,psu-1] 
    911911      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
    912912      ! 
    … …  
    944944      !!                 ***  ROUTINE eos_pt_from_ct  *** 
    945945      !! 
    946       !! ** Purpose :   Compute pot.temp. from cons. temp. [Celcius] 
     946      !! ** Purpose :   Compute pot.temp. from cons. temp. [Celsius] 
    947947      !! 
    948948      !! ** Method  :   rational approximation (5/3th order) of TEOS-10 algorithm 
    … …  
    952952      !!                Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC) 
    953953      !!---------------------------------------------------------------------- 
    954       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp [Celcius] 
    955       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity   [psu] 
     954      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp   [Celsius] 
     955      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity     [psu] 
    956956      ! Leave result array automatic rather than making explicitly allocated 
    957       REAL(wp), DIMENSION(jpi,jpj) ::   ptmp   ! potential temperature [Celcius] 
     957      REAL(wp), DIMENSION(jpi,jpj) ::   ptmp   ! potential temperature [Celsius] 
    958958      ! 
    959959      INTEGER  ::   ji, jj               ! dummy loop indices 
    … …  
    10031003      !!                 ***  ROUTINE eos_fzp  *** 
    10041004      !! 
    1005       !! ** Purpose :   Compute the freezing point temperature [Celcius] 
    1006       !! 
    1007       !! ** Method  :   UNESCO freezing point (ptf) in Celcius is given by 
     1005      !! ** Purpose :   Compute the freezing point temperature [Celsius] 
     1006      !! 
     1007      !! ** Method  :   UNESCO freezing point (ptf) in Celsius is given by 
    10081008      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z 
    10091009      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m 
    … …  
    10131013      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu] 
    10141014      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m] 
    1015       REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celcius] 
     1015      REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celsius] 
    10161016      ! 
    10171017      INTEGER  ::   ji, jj          ! dummy loop indices 
    … …  
    10561056      !!                 ***  ROUTINE eos_fzp  *** 
    10571057      !! 
    1058       !! ** Purpose :   Compute the freezing point temperature [Celcius] 
    1059       !! 
    1060       !! ** Method  :   UNESCO freezing point (ptf) in Celcius is given by 
     1058      !! ** Purpose :   Compute the freezing point temperature [Celsius] 
     1059      !! 
     1060      !! ** Method  :   UNESCO freezing point (ptf) in Celsius is given by 
    10611061      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z 
    10621062      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m 
    … …  
    10661066      REAL(wp), INTENT(in )           ::   psal         ! salinity   [psu] 
    10671067      REAL(wp), INTENT(in ), OPTIONAL ::   pdep         ! depth      [m] 
    1068       REAL(wp), INTENT(out)           ::   ptf          ! freezing temperature [Celcius] 
     1068      REAL(wp), INTENT(out)           ::   ptf          ! freezing temperature [Celsius] 
    10691069      ! 
    10701070      REAL(wp) :: zs   ! local scalars 

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

    r7403 r7421  
    290290         WRITE(numout,*) 
    291291         SELECT CASE ( nadv ) 
    292          CASE( np_NO_adv  )   ;   WRITE(numout,*) '         NO T-S advection' 
    293          CASE( np_CEN     )   ;   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   & 
     292         CASE( np_NO_adv  )   ;   WRITE(numout,*) '      ===>>   NO T-S advection' 
     293         CASE( np_CEN     )   ;   WRITE(numout,*) '      ===>>   CEN      scheme is used. Horizontal order: ', nn_cen_h,   & 
    294294            &                                                                     ' Vertical   order: ', nn_cen_v 
    295          CASE( np_FCT     )   ;   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
     295         CASE( np_FCT     )   ;   WRITE(numout,*) '      ===>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
    296296            &                                                                      ' Vertical   order: ', nn_fct_v 
    297          CASE( np_FCT_zts )   ;   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 
    298          CASE( np_MUS     )   ;   WRITE(numout,*) '         MUSCL    scheme is used' 
    299          CASE( np_UBS     )   ;   WRITE(numout,*) '         UBS      scheme is used' 
    300          CASE( np_QCK     )   ;   WRITE(numout,*) '         QUICKEST scheme is used' 
     297         CASE( np_FCT_zts )   ;   WRITE(numout,*) '      ===>>   use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 
     298         CASE( np_MUS     )   ;   WRITE(numout,*) '      ===>>   MUSCL    scheme is used' 
     299         CASE( np_UBS     )   ;   WRITE(numout,*) '      ===>>   UBS      scheme is used' 
     300         CASE( np_QCK     )   ;   WRITE(numout,*) '      ===>>   QUICKEST scheme is used' 
    301301         END SELECT 
    302302      ENDIF 

  • branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90

    r7403 r7421  
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    44    !! $Id: traadv_cen2.F90 5737 2015-09-13 07:42:41Z gm $ 
     44   !! $Id$ 
    4545   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 

  • branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

    r7403 r7421  
    4343   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6 
    4444 
     45   !                                        ! tridiag solver associated indices: 
     46   INTEGER, PARAMETER ::   np_NH   = 0   ! Neumann homogeneous boundary condition 
     47   INTEGER, PARAMETER ::   np_CEN2 = 1   ! 2nd order centered  boundary condition 
     48 
    4549   !! * Substitutions 
    4650#  include "vectopt_loop_substitute.h90" 
    … …  
    737741 
    738742 
    739    SUBROUTINE interp_4th_cpt( pt_in, pt_out ) 
    740       !!---------------------------------------------------------------------- 
    741       !!                  ***  ROUTINE interp_4th_cpt  *** 
     743   SUBROUTINE interp_4th_cpt_org( pt_in, pt_out ) 
     744      !!---------------------------------------------------------------------- 
     745      !!                  ***  ROUTINE interp_4th_cpt_org  *** 
    742746      !!  
    743747      !! **  Purpose :   Compute the interpolation of tracer at w-point 
    … …  
    770774      END DO 
    771775      ! 
    772       jk=2                                            ! Switch to second order centered at top 
    773       DO jj=1,jpj 
    774          DO ji=1,jpi 
     776      jk = 2                                          ! Switch to second order centered at top 
     777      DO jj = 1, jpj 
     778         DO ji = 1, jpi 
    775779            zwd (ji,jj,jk) = 1._wp 
    776780            zwi (ji,jj,jk) = 0._wp 
    … …  
    820824      END DO 
    821825      !     
     826   END SUBROUTINE interp_4th_cpt_org 
     827    
     828 
     829   SUBROUTINE interp_4th_cpt( pt_in, pt_out ) 
     830      !!---------------------------------------------------------------------- 
     831      !!                  ***  ROUTINE interp_4th_cpt  *** 
     832      !!  
     833      !! **  Purpose :   Compute the interpolation of tracer at w-point 
     834      !! 
     835      !! **  Method  :   4th order compact interpolation 
     836      !!---------------------------------------------------------------------- 
     837      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! field at t-point 
     838      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pt_out   ! field interpolated at w-point 
     839      ! 
     840      INTEGER ::   ji, jj, jk   ! dummy loop integers 
     841      INTEGER ::   ikt, ikb     ! local integers 
     842      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt 
     843      !!---------------------------------------------------------------------- 
     844      ! 
     845      !                      !==  build the three diagonal matrix & the RHS  ==! 
     846      ! 
     847      DO jk = 3, jpkm1                 ! interior (from jk=3 to jpk-1) 
     848         DO jj = 2, jpjm1 
     849            DO ji = fs_2, fs_jpim1 
     850               zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp                 !       diagonal 
     851               zwi (ji,jj,jk) =         wmask(ji,jj,jk)                         ! lower diagonal 
     852               zws (ji,jj,jk) =         wmask(ji,jj,jk)                         ! upper diagonal 
     853               zwrm(ji,jj,jk) = 3._wp * wmask(ji,jj,jk)                     &   ! RHS 
     854                  &           *       ( pt_in(ji,jj,jk) + pt_in(ji,jj,jk-1) ) 
     855            END DO 
     856         END DO 
     857      END DO 
     858      ! 
     859!!gm 
     860!      SELECT CASE( kbc )               !* boundary condition 
     861!      CASE( np_NH   )   ! Neumann homogeneous at top & bottom 
     862!      CASE( np_CEN2 )   ! 2nd order centered  at top & bottom 
     863!      END SELECT 
     864!!gm   
     865      ! 
     866      DO jj = 2, jpjm1                 ! 2nd order centered at top & bottom 
     867         DO ji = fs_2, fs_jpim1 
     868            ikt = mikt(ji,jj) + 1            ! w-point below the 1st  wet point 
     869            ikb = mbkt(ji,jj)                !     -   above the last wet point 
     870            ! 
     871            zwd (ji,jj,ikt) = 1._wp          ! top 
     872            zwi (ji,jj,ikt) = 0._wp 
     873            zws (ji,jj,ikt) = 0._wp 
     874            zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) ) 
     875            ! 
     876            zwd (ji,jj,ikb) = 1._wp          ! bottom 
     877            zwi (ji,jj,ikb) = 0._wp 
     878            zws (ji,jj,ikb) = 0._wp 
     879            zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )             
     880         END DO 
     881      END DO    
     882      ! 
     883      !                       !==  tridiagonal solver  ==! 
     884      ! 
     885      DO jj = 2, jpjm1              !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1 
     886         DO ji = fs_2, fs_jpim1 
     887            zwt(ji,jj,2) = zwd(ji,jj,2) 
     888         END DO 
     889      END DO 
     890      DO jk = 3, jpkm1 
     891         DO jj = 2, jpjm1 
     892            DO ji = fs_2, fs_jpim1 
     893               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1) 
     894            END DO 
     895         END DO 
     896      END DO 
     897      ! 
     898      DO jj = 2, jpjm1              !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
     899         DO ji = fs_2, fs_jpim1 
     900            pt_out(ji,jj,2) = zwrm(ji,jj,2) 
     901         END DO 
     902      END DO 
     903      DO jk = 3, jpkm1 
     904         DO jj = 2, jpjm1 
     905            DO ji = fs_2, fs_jpim1 
     906               pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)              
     907            END DO 
     908         END DO 
     909      END DO 
     910 
     911      DO jj = 2, jpjm1              !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk 
     912         DO ji = fs_2, fs_jpim1 
     913            pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 
     914         END DO 
     915      END DO 
     916      DO jk = jpk-2, 2, -1 
     917         DO jj = 2, jpjm1 
     918            DO ji = fs_2, fs_jpim1 
     919               pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 
     920            END DO 
     921         END DO 
     922      END DO 
     923      !     
    822924   END SUBROUTINE interp_4th_cpt 
    823     
     925 
     926 
     927   SUBROUTINE tridia_solver( pD, pU, pL, pRHS, pt_out , klev ) 
     928      !!---------------------------------------------------------------------- 
     929      !!                  ***  ROUTINE tridia_solver  *** 
     930      !!  
     931      !! **  Purpose :   solve a symmetric 3diagonal system 
     932      !! 
     933      !! **  Method  :   solve M.t_out = RHS(t)  where M is a tri diagonal matrix ( jpk*jpk ) 
     934      !!      
     935      !!             ( D_1 U_1  0   0   0  )( t_1 )   ( RHS_1 ) 
     936      !!             ( L_2 D_2 U_2  0   0  )( t_2 )   ( RHS_2 ) 
     937      !!             (  0  L_3 D_3 U_3  0  )( t_3 ) = ( RHS_3 ) 
     938      !!             (        ...          )( ... )   ( ...  ) 
     939      !!             (  0   0   0  L_k D_k )( t_k )   ( RHS_k ) 
     940      !!      
     941      !!        M is decomposed in the product of an upper and lower triangular matrix. 
     942      !!        The tri-diagonals matrix is given as input 3D arrays:   pD, pU, pL  
     943      !!        (i.e. the Diagonal, the Upper diagonal, and the Lower diagonal). 
     944      !!        The solution is pta. 
     945      !!        The 3d array zwt is used as a work space array. 
     946      !!---------------------------------------------------------------------- 
     947      REAL(wp),DIMENSION(:,:,:), INTENT(in   ) ::   pD, pU, PL    ! 3-diagonal matrix 
     948      REAL(wp),DIMENSION(:,:,:), INTENT(in   ) ::   pRHS          ! Right-Hand-Side 
     949      REAL(wp),DIMENSION(:,:,:), INTENT(  out) ::   pt_out        !!gm field at level=F(klev) 
     950      INTEGER                  , INTENT(in   ) ::   klev          ! =1 pt_out at w-level  
     951      !                                                           ! =0 pt at t-level 
     952      INTEGER ::   ji, jj, jk   ! dummy loop integers 
     953      INTEGER ::   kstart       ! local indices 
     954      REAL(wp),DIMENSION(jpi,jpj,jpk) ::   zwt   ! 3D work array 
     955      !!---------------------------------------------------------------------- 
     956      ! 
     957      kstart =  1  + klev 
     958      ! 
     959      DO jj = 2, jpjm1              !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1 
     960         DO ji = fs_2, fs_jpim1 
     961            zwt(ji,jj,kstart) = pD(ji,jj,kstart) 
     962         END DO 
     963      END DO 
     964      DO jk = kstart+1, jpkm1 
     965         DO jj = 2, jpjm1 
     966            DO ji = fs_2, fs_jpim1 
     967               zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1) 
     968            END DO 
     969         END DO 
     970      END DO 
     971      ! 
     972      DO jj = 2, jpjm1              !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
     973         DO ji = fs_2, fs_jpim1 
     974            pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart) 
     975         END DO 
     976      END DO 
     977      DO jk = kstart+1, jpkm1 
     978         DO jj = 2, jpjm1 
     979            DO ji = fs_2, fs_jpim1 
     980               pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)              
     981            END DO 
     982         END DO 
     983      END DO 
     984 
     985      DO jj = 2, jpjm1              !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk 
     986         DO ji = fs_2, fs_jpim1 
     987            pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 
     988         END DO 
     989      END DO 
     990      DO jk = jpk-2, kstart, -1 
     991         DO jj = 2, jpjm1 
     992            DO ji = fs_2, fs_jpim1 
     993               pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 
     994            END DO 
     995         END DO 
     996      END DO 
     997      ! 
     998   END SUBROUTINE tridia_solver 
     999 
    8241000   !!====================================================================== 
    8251001END MODULE traadv_fct 

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

    r6140 r7421  
    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 
    … …  
    329329            DO jj = 2, jpj                           ! "coriolis+ time^-1" at u- & v-points 
    330330               DO ji = fs_2, jpi   ! vector opt. 
    331                   zfu = ( ff(ji,jj) + ff(ji,jj-1) ) * 0.5_wp 
    332                   zfv = ( ff(ji,jj) + ff(ji-1,jj) ) * 0.5_wp 
     331                  zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp 
     332                  zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp 
    333333                  rfu(ji,jj) = SQRT(  zfu * zfu + z1_t2 ) 
    334334                  rfv(ji,jj) = SQRT(  zfv * zfv + z1_t2 ) 
    … …  
    347347         ! 
    348348         z1_t2 = 1._wp / ( rn_time * rn_time ) 
    349          r1_ft(:,:) = 2._wp * omega * SIN( rad * gphit(:,:) ) 
    350          r1_ft(:,:) = 1._wp / SQRT(  r1_ft(:,:) * r1_ft(:,:) + z1_t2 ) 
     349         r1_ft(:,:) = 1._wp / SQRT(  ff_t(:,:) * ff_t(:,:) + z1_t2  ) 
    351350         ! 
    352351      ENDIF 

  • branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90

    r7403 r7421  
    4040    
    4141   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits 
    42    !                                                           !  and in closed seas (orca 2 and 4 configurations) 
     42   !                                                           !  and in closed seas (orca 2 and 1 configurations) 
    4343   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index 
    4444    

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

    r6140 r7421  
    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_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r6140 r7421  
    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 
    … …  
    545545      CALL wrk_dealloc( jpi, jpj, zmbk ) 
    546546 
    547                                         !* sign of grad(H) at u- and v-points 
     547      !                                 !* sign of grad(H) at u- and v-points 
    548548      mgrhu(jpi,:) = 0   ;   mgrhu(:,jpj) = 0   ;   mgrhv(jpi,:) = 0   ;   mgrhv(:,jpj) = 0 
    549549      DO jj = 1, jpjm1 
    … …  
    553553         END DO 
    554554      END DO 
    555  
     555      ! 
    556556      DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point 
    557557         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0) 
    … …  
    561561      END DO 
    562562      CALL lbc_lnk( e3u_bbl_0, 'U', 1. )   ;   CALL lbc_lnk( e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions 
    563  
     563      ! 
    564564      !                             !* masked diffusive flux coefficients 
    565565      ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 
    566566      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 
    567567 
    568  
    569       IF( cp_cfg == "orca" ) THEN   !* ORCA configuration : regional enhancement of ah_bbl 
    570          ! 
    571          SELECT CASE ( jp_cfg ) 
    572          CASE ( 2 )                          ! ORCA_R2 
    573             ij0 = 102   ;   ij1 = 102              ! Gibraltar enhancement of BBL 
    574             ii0 = 139   ;   ii1 = 140 
    575             ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    576             ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    577             ! 
    578             ij0 =  88   ;   ij1 =  88              ! Red Sea enhancement of BBL 
    579             ii0 = 161   ;   ii1 = 162 
    580             ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    581             ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    582             ! 
    583          CASE ( 4 )                          ! ORCA_R4 
    584             ij0 =  52   ;   ij1 =  52              ! Gibraltar enhancement of BBL 
    585             ii0 =  70   ;   ii1 =  71 
    586             ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    587             ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    588          END SELECT 
    589          ! 
    590       ENDIF 
    591568      ! 
    592569      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_init') 

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

    r6140 r7421  
    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_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r6352 r7421  
    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_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r6403 r7421  
    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_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r6140 r7421  
    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      ! 
Note: See TracChangeset for help on using the changeset viewer.