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 4155 for branches – NEMO

Changeset 4155 for branches


Ignore:
Timestamp:
2013-11-05T15:24:22+01:00 (10 years ago)
Author:
clem
Message:
 
Location:
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO
Files:
11 edited

Legend:

Unmodified
Added
Removed

  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r4099 r4155  
    188188   REAL(wp), PUBLIC ::   alphaevp = 1._wp      !: coeficient of the internal stresses !SB 
    189189   REAL(wp), PUBLIC ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy 
    190    REAL(wp), PUBLIC ::   hminrhg = 0.05_wp     !: clem : ice thickness (in m) below which ice velocity is set to ocean velocity 
     190   REAL(wp), PUBLIC ::   hminrhg = 0.001_wp    !: clem : ice volume (a*h, in m) below which ice velocity is set to ocean velocity 
    191191 
    192192   !                                              !!** ice-salinity namelist (namicesal) ** 

  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90

    r4099 r4155  
    135135         ln_nicep = .FALSE. 
    136136         CALL ctl_warn( 'ice_run : specific control print for LIM3 desactivated with MPI' ) 
    137       ENDIF        
     137      ENDIF 
    138138      ! 
    139139      IF(lwp) THEN                        ! control print 

  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r4072 r4155  
    224224      ENDIF 
    225225      ! 
    226  
    227226      ! ------------------------------- 
    228227      !- check conservation (C Rousset) 

  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r4072 r4155  
    161161      ! ------------------------------- 
    162162      !- check conservation (C Rousset) 
    163       IF (ln_limdiahsb) THEN 
     163      IF( ln_limdiahsb ) THEN 
    164164         zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    165165         zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 

  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r4099 r4155  
    659659         DO ji = fs_2, fs_jpim1 
    660660            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) )  
    661             zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
    662             !zdummy = vt_i(ji,jj) 
     661            !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
     662            zdummy = vt_i(ji,jj) 
    663663            IF ( zdummy .LE. hminrhg ) THEN 
    664664               u_ice(ji,jj) = u_oce(ji,jj) 
    … …  
    682682         DO ji = fs_2, fs_jpim1 
    683683            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) )  
    684             zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
    685             !zdummy = vt_i(ji,jj) 
     684            !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
     685            zdummy = vt_i(ji,jj) 
    686686            IF ( zdummy .LE. hminrhg ) THEN 
    687687               v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   & 
    … …  
    707707            !- zds(:,:): shear on northeast corner of grid cells 
    708708            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) )  
    709             zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
    710             !zdummy = vt_i(ji,jj) 
     709            !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
     710            zdummy = vt_i(ji,jj) 
    711711            IF ( zdummy .LE. hminrhg ) THEN 
    712712 

  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r4072 r4155  
    8181      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   zs0e 
    8282      REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    83       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
     83      REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax, zchk_umax ! Check errors (C Rousset) 
    8484      ! mass and salt flux (clem) 
    8585      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold   ! old ice volume... 
    … …  
    9999      ! ------------------------------- 
    100100      !- check conservation (C Rousset) 
    101       IF (ln_limdiahsb) THEN 
     101      IF( ln_limdiahsb ) THEN 
    102102         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    103103         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    … …  
    456456 
    457457                  ! Ice salinity and age 
    458                   zsal = MAX( MIN(  (rhoic-rhosn)/rhoic*sss_m(ji,jj) ,   & 
    459                      &              zusvoic * zs0sm(ji,jj,jl)         ) , s_i_min ) * v_i(ji,jj,jl) 
    460                   IF(  num_sal == 2  )   smv_i(ji,jj,jl) = zindic * zsal 
    461  
    462                   zage = MAX(  MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi16 ) ), 0._wp  ) * a_i(ji,jj,jl) 
     458                  !clem zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj), zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 
     459                  IF(  num_sal == 2  ) THEN 
     460                     smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 
     461                  ENDIF 
     462 
     463                  zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi16 ) ), 0._wp  ) * a_i(ji,jj,jl) 
    463464                  oa_i (ji,jj,jl)  = zindic * zage  
    464465 
    … …  
    544545      ! ------------------------------- 
    545546      !- check conservation (C Rousset) 
    546       IF (ln_limdiahsb) THEN 
     547      IF( ln_limdiahsb ) THEN 
    547548         zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    548549         zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    … …  
    554555         zchk_amax = glob_max(SUM(a_i,dim=3)) 
    555556         zchk_amin = glob_min(a_i) 
     557         zchk_umax = glob_max(SQRT(u_ice**2 + v_ice**2)) 
    556558 
    557559         IF(lwp) THEN 
    558             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limtrp) = ',(zchk_v_i * rday) 
     560            IF ( ABS( zchk_v_i   ) >  1.e-5 ) THEN 
     561               WRITE(numout,*) 'violation volume [m3/day]     (limtrp) = ',(zchk_v_i * rday) 
     562               WRITE(numout,*) 'u_ice max [m/s]               (limtrp) = ',zchk_umax 
     563               WRITE(numout,*) 'number of time steps          (limtrp) =',kt 
     564            ENDIF 
    559565            IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limtrp) = ',(zchk_smv * rday) 
    560566            IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limtrp) = ',(zchk_vmin * 1.e-3) 

  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r4099 r4155  
    3030 
    3131   PUBLIC sbc_ice_alloc ! called in iceini(_2).F90 
    32  
    33    CHARACTER (len=8), PUBLIC :: cn_iceflx = 'none'                !: Flux handling over ice categories 
    34    LOGICAL, PUBLIC :: ln_iceflx_ave    = .FALSE. ! Average heat fluxes over all ice categories 
    35    LOGICAL, PUBLIC :: ln_iceflx_linear = .FALSE. ! Redistribute mean heat fluxes over all ice categories, using ice temperature and albedo 
    3632 
    3733# if defined  key_lim2 

  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r4039 r4155  
    5353   LOGICAL , PUBLIC ::   ln_cdgw     = .FALSE.   !: true if neutral drag coefficient from wave model 
    5454   LOGICAL , PUBLIC ::   ln_sdw      = .FALSE.   !: true if 3d stokes drift from wave model 
    55  
     55   ! 
     56   CHARACTER (len=8), PUBLIC :: cn_iceflx = 'none' !: Flux handling over ice categories 
     57   LOGICAL, PUBLIC :: ln_iceflx_ave    = .FALSE. ! Average heat fluxes over all ice categories 
     58   LOGICAL, PUBLIC :: ln_iceflx_linear = .FALSE. ! Redistribute mean heat fluxes over all ice categories, using ice temperature and albedo 
     59   ! 
    5660   !!---------------------------------------------------------------------- 
    5761   !!              Ocean Surface Boundary Condition fields 

  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r4099 r4155  
    241241      ENDIF 
    242242      ! 
     243                          CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
     244      ! 
    243245      IF( ln_ssr      )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
    244246      ! 

  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

    r4036 r4155  
    2525 
    2626   PUBLIC   glob_sum   ! used in many places 
     27   PUBLIC   DDPDD      ! also used in closea module 
    2728   PUBLIC   glob_min, glob_max 
    28    PUBLIC   DDPDD      ! also used in closea module 
    2929#if defined key_nosignedzero 
    3030   PUBLIC SIGN 
    … …  
    156156      ! 
    157157   END FUNCTION glob_sum_3d_a 
    158  
    159    ! --- MIN --- 
    160    FUNCTION glob_min_2d( ptab )  
    161       !!----------------------------------------------------------------------- 
    162       !!                  ***  FUNCTION  glob_min_2D  *** 
    163       !! 
    164       !! ** Purpose : perform a masked min on the inner global domain of a 2D array 
    165       !!----------------------------------------------------------------------- 
    166       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
    167       REAL(wp)                             ::   glob_min_2d   ! global masked min 
    168       !!----------------------------------------------------------------------- 
    169       ! 
    170       glob_min_2d = MINVAL( ptab(:,:)*tmask_i(:,:) ) 
    171       IF( lk_mpp )   CALL mpp_min( glob_min_2d ) 
    172       ! 
    173    END FUNCTION glob_min_2d 
    174   
    175    FUNCTION glob_min_3d( ptab )  
    176       !!----------------------------------------------------------------------- 
    177       !!                  ***  FUNCTION  glob_min_3D  *** 
    178       !! 
    179       !! ** Purpose : perform a masked min on the inner global domain of a 3D array 
    180       !!----------------------------------------------------------------------- 
    181       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
    182       REAL(wp)                               ::   glob_min_3d   ! global masked min 
    183       !! 
    184       INTEGER :: jk 
    185       INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    186       !!----------------------------------------------------------------------- 
    187       ! 
    188       ijpk = SIZE(ptab,3) 
    189       ! 
    190       glob_min_3d = 0.e0 
    191       DO jk = 1, ijpk 
    192          glob_min_3d = glob_min_3d + MINVAL( ptab(:,:,jk)*tmask_i(:,:) ) 
    193       END DO 
    194       IF( lk_mpp )   CALL mpp_min( glob_min_3d ) 
    195       ! 
    196    END FUNCTION glob_min_3d 
    197  
    198  
    199    FUNCTION glob_min_2d_a( ptab1, ptab2 )  
    200       !!----------------------------------------------------------------------- 
    201       !!                  ***  FUNCTION  glob_min_2D _a *** 
    202       !! 
    203       !! ** Purpose : perform a masked min on the inner global domain of two 2D array 
    204       !!----------------------------------------------------------------------- 
    205       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array 
    206       REAL(wp)            , DIMENSION(2)   ::   glob_min_2d_a   ! global masked min 
    207       !!----------------------------------------------------------------------- 
    208       !              
    209       glob_min_2d_a(1) = MINVAL( ptab1(:,:)*tmask_i(:,:) ) 
    210       glob_min_2d_a(2) = MINVAL( ptab2(:,:)*tmask_i(:,:) ) 
    211       IF( lk_mpp )   CALL mpp_min( glob_min_2d_a, 2 ) 
    212       ! 
    213    END FUNCTION glob_min_2d_a 
    214   
    215   
    216    FUNCTION glob_min_3d_a( ptab1, ptab2 )  
    217       !!----------------------------------------------------------------------- 
    218       !!                  ***  FUNCTION  glob_min_3D_a *** 
    219       !! 
    220       !! ** Purpose : perform a masked min on the inner global domain of two 3D array 
    221       !!----------------------------------------------------------------------- 
    222       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
    223       REAL(wp)            , DIMENSION(2)     ::   glob_min_3d_a   ! global masked min 
    224       !! 
    225       INTEGER :: jk 
    226       INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    227       !!----------------------------------------------------------------------- 
    228       ! 
    229       ijpk = SIZE(ptab1,3) 
    230       ! 
    231       glob_min_3d_a(:) = 0.e0 
    232       DO jk = 1, ijpk 
    233          glob_min_3d_a(1) = glob_min_3d_a(1) + MINVAL( ptab1(:,:,jk)*tmask_i(:,:) ) 
    234          glob_min_3d_a(2) = glob_min_3d_a(2) + MINVAL( ptab2(:,:,jk)*tmask_i(:,:) ) 
    235       END DO 
    236       IF( lk_mpp )   CALL mpp_min( glob_min_3d_a, 2 ) 
    237       ! 
    238    END FUNCTION glob_min_3d_a 
    239  
    240    ! --- MAX --- 
    241    FUNCTION glob_max_2d( ptab )  
    242       !!----------------------------------------------------------------------- 
    243       !!                  ***  FUNCTION  glob_max_2D  *** 
    244       !! 
    245       !! ** Purpose : perform a masked max on the inner global domain of a 2D array 
    246       !!----------------------------------------------------------------------- 
    247       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
    248       REAL(wp)                             ::   glob_max_2d   ! global masked max 
    249       !!----------------------------------------------------------------------- 
    250       ! 
    251       glob_max_2d = MAXVAL( ptab(:,:)*tmask_i(:,:) ) 
    252       IF( lk_mpp )   CALL mpp_max( glob_max_2d ) 
    253       ! 
    254    END FUNCTION glob_max_2d 
    255   
    256    FUNCTION glob_max_3d( ptab )  
    257       !!----------------------------------------------------------------------- 
    258       !!                  ***  FUNCTION  glob_max_3D  *** 
    259       !! 
    260       !! ** Purpose : perform a masked max on the inner global domain of a 3D array 
    261       !!----------------------------------------------------------------------- 
    262       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
    263       REAL(wp)                               ::   glob_max_3d   ! global masked max 
    264       !! 
    265       INTEGER :: jk 
    266       INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    267       !!----------------------------------------------------------------------- 
    268       ! 
    269       ijpk = SIZE(ptab,3) 
    270       ! 
    271       glob_max_3d = 0.e0 
    272       DO jk = 1, ijpk 
    273          glob_max_3d = glob_max_3d + MAXVAL( ptab(:,:,jk)*tmask_i(:,:) ) 
    274       END DO 
    275       IF( lk_mpp )   CALL mpp_max( glob_max_3d ) 
    276       ! 
    277    END FUNCTION glob_max_3d 
    278  
    279  
    280    FUNCTION glob_max_2d_a( ptab1, ptab2 )  
    281       !!----------------------------------------------------------------------- 
    282       !!                  ***  FUNCTION  glob_max_2D _a *** 
    283       !! 
    284       !! ** Purpose : perform a masked max on the inner global domain of two 2D array 
    285       !!----------------------------------------------------------------------- 
    286       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array 
    287       REAL(wp)            , DIMENSION(2)   ::   glob_max_2d_a   ! global masked max 
    288       !!----------------------------------------------------------------------- 
    289       !              
    290       glob_max_2d_a(1) = MAXVAL( ptab1(:,:)*tmask_i(:,:) ) 
    291       glob_max_2d_a(2) = MAXVAL( ptab2(:,:)*tmask_i(:,:) ) 
    292       IF( lk_mpp )   CALL mpp_max( glob_max_2d_a, 2 ) 
    293       ! 
    294    END FUNCTION glob_max_2d_a 
    295   
    296   
    297    FUNCTION glob_max_3d_a( ptab1, ptab2 )  
    298       !!----------------------------------------------------------------------- 
    299       !!                  ***  FUNCTION  glob_max_3D_a *** 
    300       !! 
    301       !! ** Purpose : perform a masked max on the inner global domain of two 3D array 
    302       !!----------------------------------------------------------------------- 
    303       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
    304       REAL(wp)            , DIMENSION(2)     ::   glob_max_3d_a   ! global masked max 
    305       !! 
    306       INTEGER :: jk 
    307       INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    308       !!----------------------------------------------------------------------- 
    309       ! 
    310       ijpk = SIZE(ptab1,3) 
    311       ! 
    312       glob_max_3d_a(:) = 0.e0 
    313       DO jk = 1, ijpk 
    314          glob_max_3d_a(1) = glob_max_3d_a(1) + MAXVAL( ptab1(:,:,jk)*tmask_i(:,:) ) 
    315          glob_max_3d_a(2) = glob_max_3d_a(2) + MAXVAL( ptab2(:,:,jk)*tmask_i(:,:) ) 
    316       END DO 
    317       IF( lk_mpp )   CALL mpp_max( glob_max_3d_a, 2 ) 
    318       ! 
    319    END FUNCTION glob_max_3d_a 
    320  
    321158 
    322159#else   
    … …  
    477314   END FUNCTION glob_sum_3d_a    
    478315 
     316#endif 
    479317 
    480318   ! --- MIN --- 
    481319   FUNCTION glob_min_2d( ptab )  
    482       !!---------------------------------------------------------------------- 
    483       !!                  ***  FUNCTION  glob_min_2d *** 
    484       !! 
    485       !! ** Purpose : perform a min in calling DDPDD routine 
    486       !!---------------------------------------------------------------------- 
    487       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
     320      !!----------------------------------------------------------------------- 
     321      !!                  ***  FUNCTION  glob_min_2D *** 
     322      !! 
     323      !! ** Purpose : perform a masked min on the inner global domain of a 2D array 
     324      !!----------------------------------------------------------------------- 
     325      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
    488326      REAL(wp)                             ::   glob_min_2d   ! global masked min 
    489       !! 
    490       COMPLEX(wp)::   ctmp 
    491       REAL(wp)   ::   ztmp 
    492       INTEGER    ::   ji, jj   ! dummy loop indices 
    493       !!----------------------------------------------------------------------- 
    494       ! 
    495       ztmp = 0.e0 
    496       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    497       DO jj = 1, jpj 
    498          DO ji = 1, jpi 
    499             ztmp =  ptab(ji,jj) * tmask_i(ji,jj) 
    500             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    501          END DO 
    502       END DO 
    503       IF( lk_mpp )   CALL mpp_min( ctmp )   ! min over the global domain 
    504       glob_min_2d = REAL(ctmp,wp) 
    505       ! 
    506    END FUNCTION glob_min_2d    
    507  
    508  
     327      !!----------------------------------------------------------------------- 
     328      ! 
     329      glob_min_2d = MINVAL( ptab(:,:)*tmask_i(:,:) ) 
     330      IF( lk_mpp )   CALL mpp_min( glob_min_2d ) 
     331      ! 
     332   END FUNCTION glob_min_2d 
     333  
    509334   FUNCTION glob_min_3d( ptab )  
    510       !!---------------------------------------------------------------------- 
    511       !!                  ***  FUNCTION  glob_min_3d *** 
    512       !! 
    513       !! ** Purpose : perform a min on a 3D array in calling DDPDD routine 
    514       !!---------------------------------------------------------------------- 
    515       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab 
     335      !!----------------------------------------------------------------------- 
     336      !!                  ***  FUNCTION  glob_min_3D *** 
     337      !! 
     338      !! ** Purpose : perform a masked min on the inner global domain of a 3D array 
     339      !!----------------------------------------------------------------------- 
     340      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
    516341      REAL(wp)                               ::   glob_min_3d   ! global masked min 
    517342      !! 
    518       COMPLEX(wp)::   ctmp 
    519       REAL(wp)   ::   ztmp 
    520       INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    521       INTEGER    ::   ijpk ! local variables: size of ptab 
     343      INTEGER :: jk 
     344      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    522345      !!----------------------------------------------------------------------- 
    523346      ! 
    524347      ijpk = SIZE(ptab,3) 
    525348      ! 
    526       ztmp = 0.e0 
    527       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    528       DO jk = 1, ijpk 
    529          DO jj = 1, jpj 
    530             DO ji = 1, jpi 
    531                ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj) 
    532                CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    533             END DO 
    534          END DO     
    535       END DO 
    536       IF( lk_mpp )   CALL mpp_min( ctmp )   ! min over the global domain 
    537       glob_min_3d = REAL(ctmp,wp) 
    538       ! 
    539    END FUNCTION glob_min_3d    
     349      glob_min_3d = MINVAL( ptab(:,:,1)*tmask_i(:,:) ) 
     350      DO jk = 2, ijpk 
     351         glob_min_3d = MIN( glob_min_3d, MINVAL( ptab(:,:,jk)*tmask_i(:,:) ) ) 
     352      END DO 
     353      IF( lk_mpp )   CALL mpp_min( glob_min_3d ) 
     354      ! 
     355   END FUNCTION glob_min_3d 
    540356 
    541357 
    542358   FUNCTION glob_min_2d_a( ptab1, ptab2 )  
    543       !!---------------------------------------------------------------------- 
    544       !!                  ***  FUNCTION  glob_min_2d_a *** 
    545       !! 
    546       !! ** Purpose : perform a min on two 2D arrays in calling DDPDD routine 
    547       !!---------------------------------------------------------------------- 
    548       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2 
    549       REAL(wp)                             ::   glob_min_2d_a   ! global masked min 
    550       !! 
    551       COMPLEX(wp)::   ctmp 
    552       REAL(wp)   ::   ztmp 
    553       INTEGER    ::   ji, jj   ! dummy loop indices 
    554       !!----------------------------------------------------------------------- 
    555       ! 
    556       ! 
    557       ztmp = 0.e0 
    558       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    559       DO jj = 1, jpj 
    560          DO ji = 1, jpi 
    561             ztmp =  ptab1(ji,jj) * tmask_i(ji,jj) 
    562             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    563             ztmp =  ptab2(ji,jj) * tmask_i(ji,jj) 
    564             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    565          END DO 
    566       END DO 
    567       IF( lk_mpp )   CALL mpp_min( ctmp )   ! min over the global domain 
    568       glob_min_2d_a = REAL(ctmp,wp) 
    569       ! 
    570    END FUNCTION glob_min_2d_a    
    571  
    572  
     359      !!----------------------------------------------------------------------- 
     360      !!                  ***  FUNCTION  glob_min_2D _a *** 
     361      !! 
     362      !! ** Purpose : perform a masked min on the inner global domain of two 2D array 
     363      !!----------------------------------------------------------------------- 
     364      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array 
     365      REAL(wp)            , DIMENSION(2)   ::   glob_min_2d_a   ! global masked min 
     366      !!----------------------------------------------------------------------- 
     367      !              
     368      glob_min_2d_a(1) = MINVAL( ptab1(:,:)*tmask_i(:,:) ) 
     369      glob_min_2d_a(2) = MINVAL( ptab2(:,:)*tmask_i(:,:) ) 
     370      IF( lk_mpp )   CALL mpp_min( glob_min_2d_a, 2 ) 
     371      ! 
     372   END FUNCTION glob_min_2d_a 
     373  
     374  
    573375   FUNCTION glob_min_3d_a( ptab1, ptab2 )  
    574       !!---------------------------------------------------------------------- 
    575       !!                  ***  FUNCTION  glob_min_3d_a *** 
    576       !! 
    577       !! ** Purpose : perform a min on two 3D array in calling DDPDD routine 
    578       !!---------------------------------------------------------------------- 
    579       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2 
    580       REAL(wp)                               ::   glob_min_3d_a   ! global masked min 
    581       !! 
    582       COMPLEX(wp)::   ctmp 
    583       REAL(wp)   ::   ztmp 
    584       INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    585       INTEGER    ::   ijpk ! local variables: size of ptab 
     376      !!----------------------------------------------------------------------- 
     377      !!                  ***  FUNCTION  glob_min_3D_a *** 
     378      !! 
     379      !! ** Purpose : perform a masked min on the inner global domain of two 3D array 
     380      !!----------------------------------------------------------------------- 
     381      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
     382      REAL(wp)            , DIMENSION(2)     ::   glob_min_3d_a   ! global masked min 
     383      !! 
     384      INTEGER :: jk 
     385      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    586386      !!----------------------------------------------------------------------- 
    587387      ! 
    588388      ijpk = SIZE(ptab1,3) 
    589389      ! 
    590       ztmp = 0.e0 
    591       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    592       DO jk = 1, ijpk 
    593          DO jj = 1, jpj 
    594             DO ji = 1, jpi 
    595                ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj) 
    596                CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    597                ztmp =  ptab2(ji,jj,jk) * tmask_i(ji,jj) 
    598                CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    599             END DO 
    600          END DO     
    601       END DO 
    602       IF( lk_mpp )   CALL mpp_min( ctmp )   ! min over the global domain 
    603       glob_min_3d_a = REAL(ctmp,wp) 
    604       ! 
    605    END FUNCTION glob_min_3d_a    
    606  
    607   
     390      glob_min_3d_a(1) = MINVAL( ptab1(:,:,1)*tmask_i(:,:) ) 
     391      glob_min_3d_a(2) = MINVAL( ptab2(:,:,1)*tmask_i(:,:) ) 
     392      DO jk = 2, ijpk 
     393         glob_min_3d_a(1) = MIN( glob_min_3d_a(1), MINVAL( ptab1(:,:,jk)*tmask_i(:,:) ) ) 
     394         glob_min_3d_a(2) = MIN( glob_min_3d_a(2), MINVAL( ptab2(:,:,jk)*tmask_i(:,:) ) ) 
     395      END DO 
     396      IF( lk_mpp )   CALL mpp_min( glob_min_3d_a, 2 ) 
     397      ! 
     398   END FUNCTION glob_min_3d_a 
     399 
    608400   ! --- MAX --- 
    609401   FUNCTION glob_max_2d( ptab )  
    610       !!---------------------------------------------------------------------- 
    611       !!                  ***  FUNCTION  glob_max_2d *** 
    612       !! 
    613       !! ** Purpose : perform a max in calling DDPDD routine 
    614       !!---------------------------------------------------------------------- 
    615       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
     402      !!----------------------------------------------------------------------- 
     403      !!                  ***  FUNCTION  glob_max_2D *** 
     404      !! 
     405      !! ** Purpose : perform a masked max on the inner global domain of a 2D array 
     406      !!----------------------------------------------------------------------- 
     407      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
    616408      REAL(wp)                             ::   glob_max_2d   ! global masked max 
    617       !! 
    618       COMPLEX(wp)::   ctmp 
    619       REAL(wp)   ::   ztmp 
    620       INTEGER    ::   ji, jj   ! dummy loop indices 
    621       !!----------------------------------------------------------------------- 
    622       ! 
    623       ztmp = 0.e0 
    624       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    625       DO jj = 1, jpj 
    626          DO ji = 1, jpi 
    627             ztmp =  ptab(ji,jj) * tmask_i(ji,jj) 
    628             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    629          END DO 
    630       END DO 
    631       IF( lk_mpp )   CALL mpp_max( ctmp )   ! max over the global domain 
    632       glob_max_2d = REAL(ctmp,wp) 
    633       ! 
    634    END FUNCTION glob_max_2d    
    635  
    636  
     409      !!----------------------------------------------------------------------- 
     410      ! 
     411      glob_max_2d = MAXVAL( ptab(:,:)*tmask_i(:,:) ) 
     412      IF( lk_mpp )   CALL mpp_max( glob_max_2d ) 
     413      ! 
     414   END FUNCTION glob_max_2d 
     415  
    637416   FUNCTION glob_max_3d( ptab )  
    638       !!---------------------------------------------------------------------- 
    639       !!                  ***  FUNCTION  glob_max_3d *** 
    640       !! 
    641       !! ** Purpose : perform a max on a 3D array in calling DDPDD routine 
    642       !!---------------------------------------------------------------------- 
    643       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab 
     417      !!----------------------------------------------------------------------- 
     418      !!                  ***  FUNCTION  glob_max_3D *** 
     419      !! 
     420      !! ** Purpose : perform a masked max on the inner global domain of a 3D array 
     421      !!----------------------------------------------------------------------- 
     422      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
    644423      REAL(wp)                               ::   glob_max_3d   ! global masked max 
    645424      !! 
    646       COMPLEX(wp)::   ctmp 
    647       REAL(wp)   ::   ztmp 
    648       INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    649       INTEGER    ::   ijpk ! local variables: size of ptab 
     425      INTEGER :: jk 
     426      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    650427      !!----------------------------------------------------------------------- 
    651428      ! 
    652429      ijpk = SIZE(ptab,3) 
    653430      ! 
    654       ztmp = 0.e0 
    655       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    656       DO jk = 1, ijpk 
    657          DO jj = 1, jpj 
    658             DO ji = 1, jpi 
    659                ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj) 
    660                CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    661             END DO 
    662          END DO     
    663       END DO 
    664       IF( lk_mpp )   CALL mpp_max( ctmp )   ! max over the global domain 
    665       glob_max_3d = REAL(ctmp,wp) 
    666       ! 
    667    END FUNCTION glob_max_3d    
     431      glob_max_3d = MAXVAL( ptab(:,:,1)*tmask_i(:,:) ) 
     432      DO jk = 2, ijpk 
     433         glob_max_3d = MAX( glob_max_3d, MAXVAL( ptab(:,:,jk)*tmask_i(:,:) ) ) 
     434      END DO 
     435      IF( lk_mpp )   CALL mpp_max( glob_max_3d ) 
     436      ! 
     437   END FUNCTION glob_max_3d 
    668438 
    669439 
    670440   FUNCTION glob_max_2d_a( ptab1, ptab2 )  
    671       !!---------------------------------------------------------------------- 
    672       !!                  ***  FUNCTION  glob_max_2d_a *** 
    673       !! 
    674       !! ** Purpose : perform a max on two 2D arrays in calling DDPDD routine 
    675       !!---------------------------------------------------------------------- 
    676       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2 
    677       REAL(wp)                             ::   glob_max_2d_a   ! global masked max 
    678       !! 
    679       COMPLEX(wp)::   ctmp 
    680       REAL(wp)   ::   ztmp 
    681       INTEGER    ::   ji, jj   ! dummy loop indices 
    682       !!----------------------------------------------------------------------- 
    683       ! 
    684       ! 
    685       ztmp = 0.e0 
    686       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    687       DO jj = 1, jpj 
    688          DO ji = 1, jpi 
    689             ztmp =  ptab1(ji,jj) * tmask_i(ji,jj) 
    690             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    691             ztmp =  ptab2(ji,jj) * tmask_i(ji,jj) 
    692             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    693          END DO 
    694       END DO 
    695       IF( lk_mpp )   CALL mpp_max( ctmp )   ! max over the global domain 
    696       glob_max_2d_a = REAL(ctmp,wp) 
    697       ! 
    698    END FUNCTION glob_max_2d_a    
    699  
    700  
     441      !!----------------------------------------------------------------------- 
     442      !!                  ***  FUNCTION  glob_max_2D _a *** 
     443      !! 
     444      !! ** Purpose : perform a masked max on the inner global domain of two 2D array 
     445      !!----------------------------------------------------------------------- 
     446      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array 
     447      REAL(wp)            , DIMENSION(2)   ::   glob_max_2d_a   ! global masked max 
     448      !!----------------------------------------------------------------------- 
     449      !              
     450      glob_max_2d_a(1) = MAXVAL( ptab1(:,:)*tmask_i(:,:) ) 
     451      glob_max_2d_a(2) = MAXVAL( ptab2(:,:)*tmask_i(:,:) ) 
     452      IF( lk_mpp )   CALL mpp_max( glob_max_2d_a, 2 ) 
     453      ! 
     454   END FUNCTION glob_max_2d_a 
     455  
     456  
    701457   FUNCTION glob_max_3d_a( ptab1, ptab2 )  
    702       !!---------------------------------------------------------------------- 
    703       !!                  ***  FUNCTION  glob_max_3d_a *** 
    704       !! 
    705       !! ** Purpose : perform a max on two 3D array in calling DDPDD routine 
    706       !!---------------------------------------------------------------------- 
    707       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2 
    708       REAL(wp)                               ::   glob_max_3d_a   ! global masked max 
    709       !! 
    710       COMPLEX(wp)::   ctmp 
    711       REAL(wp)   ::   ztmp 
    712       INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    713       INTEGER    ::   ijpk ! local variables: size of ptab 
     458      !!----------------------------------------------------------------------- 
     459      !!                  ***  FUNCTION  glob_max_3D_a *** 
     460      !! 
     461      !! ** Purpose : perform a masked max on the inner global domain of two 3D array 
     462      !!----------------------------------------------------------------------- 
     463      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
     464      REAL(wp)            , DIMENSION(2)     ::   glob_max_3d_a   ! global masked max 
     465      !! 
     466      INTEGER :: jk 
     467      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    714468      !!----------------------------------------------------------------------- 
    715469      ! 
    716470      ijpk = SIZE(ptab1,3) 
    717471      ! 
    718       ztmp = 0.e0 
    719       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    720       DO jk = 1, ijpk 
    721          DO jj = 1, jpj 
    722             DO ji = 1, jpi 
    723                ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj) 
    724                CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    725                ztmp =  ptab2(ji,jj,jk) * tmask_i(ji,jj) 
    726                CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    727             END DO 
    728          END DO     
    729       END DO 
    730       IF( lk_mpp )   CALL mpp_max( ctmp )   ! max over the global domain 
    731       glob_max_3d_a = REAL(ctmp,wp) 
    732       ! 
    733    END FUNCTION glob_max_3d_a    
    734  
    735 #endif 
     472      glob_max_3d_a(1) = MAXVAL( ptab1(:,:,1)*tmask_i(:,:) ) 
     473      glob_max_3d_a(2) = MAXVAL( ptab2(:,:,1)*tmask_i(:,:) ) 
     474      DO jk = 2, ijpk 
     475         glob_max_3d_a(1) = MAX( glob_max_3d_a(1), MAXVAL( ptab1(:,:,jk)*tmask_i(:,:) ) ) 
     476         glob_max_3d_a(2) = MAX( glob_max_3d_a(2), MAXVAL( ptab2(:,:,jk)*tmask_i(:,:) ) ) 
     477      END DO 
     478      IF( lk_mpp )   CALL mpp_max( glob_max_3d_a, 2 ) 
     479      ! 
     480   END FUNCTION glob_max_3d_a 
     481 
    736482 
    737483   SUBROUTINE DDPDD( ydda, yddb ) 

  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/step.F90

    r4037 r4155  
    108108      ! 
    109109      !  VERTICAL PHYSICS 
     110      ! bg jchanut tschanges 
     111      ! One need bottom friction parameter in ssh_wzv routine with time splitting. 
     112      ! The idea could be to move the call below before ssh_wzv. However, "now" scale factors 
     113      ! at U-V points (which are set thanks to sshu_n, sshv_n) are actually available in sshwzv. 
     114      ! These are needed for log bottom friction... 
     115#if ! defined key_dynspg_ts 
    110116                         CALL zdf_bfr( kstp )         ! bottom friction 
     117#endif 
     118      ! end jchanut tschanges 
    111119 
    112120      !                                               ! Vertical eddy viscosity and diffusivity coefficients 
    … …  
    206214            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level 
    207215 
    208       ELSE                                                  ! centered hpg  (eos then time stepping) 
     216      ELSE    
     217                                               ! centered hpg  (eos then time stepping) 
     218      ! bg jchanut tschanges 
     219#if ! defined key_dynspg_ts 
     220      ! eos already called 
    209221                             CALL eos    ( tsn, rhd, rhop )      ! now in situ density for hpg computation 
    210222         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv,  &    ! zps: now hor. derivative 
    211223            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level 
     224#endif 
     225      ! end jchanut tschanges 
    212226         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    213227                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
    … …  
    217231      ! Dynamics                                    (tsa used as workspace) 
    218232      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     233      ! bg jchanut tschanges 
     234#if defined key_dynspg_ts       
     235! revert to previously computed tendencies: 
     236! (not using ua, va as temporary arrays during tracers' update could avoid that) 
     237                               ua(:,:,:) = ua_bak(:,:,:)             
     238                               va(:,:,:) = va_bak(:,:,:) 
     239                               CALL dyn_bfr( kstp )         ! bottom friction 
     240                               CALL dyn_zdf( kstp )         ! vertical diffusion 
     241#else 
     242      ! end jchanut tschanges 
    219243                               ua(:,:,:) = 0.e0             ! set dynamics trends to zero 
    220244                               va(:,:,:) = 0.e0 
    … …  
    236260                               CALL dyn_zdf( kstp )         ! vertical diffusion 
    237261                               CALL dyn_spg( kstp, indic )  ! surface pressure gradient 
     262      ! bg jchanut tschanges 
     263#endif 
     264      ! end jchanut tschanges 
    238265                               CALL dyn_nxt( kstp )         ! lateral velocity at next time step 
    239266 
Note: See TracChangeset for help on using the changeset viewer.