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

Changeset 5737


Ignore:
Timestamp:
2015-09-13T09:42:41+02:00 (9 years ago)
Author:
gm
Message:

#1593: LDF-ADV, step I: Phasing of horizontal scale factors correct 2

Location:
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO
Files:
59 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r5429 r5737  
    9797 
    9898      !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                      
    99       psm (:,:)  = MAX( pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 
     99      psm (:,:)  = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 
    100100 
    101101      !  Calculate fluxes and moments between boxes i<-->i+1               
     
    282282 
    283283      !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
    284       psm(:,:)  = MAX(  pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  ) 
     284      psm(:,:)  = MAX(  pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  ) 
    285285 
    286286      !  Calculate fluxes and moments between boxes j<-->j+1               
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r5183 r5737  
    185185         zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    186186            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
    187             &                ) *  e12t(:,:) * tmask(:,:,1) * zconv ) 
     187            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv ) 
    188188 
    189189         ! water flux 
    190190         zfw_b  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
    191191            &                  wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
    192             &                ) *  e12t(:,:) * tmask(:,:,1) * zconv ) 
     192            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv ) 
    193193 
    194194         ! heat flux 
    195195         zft_b  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
    196196            &                - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
    197             &                ) *  e12t(:,:) * tmask(:,:,1) * zconv ) 
    198  
    199          zvi_b  = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e12t * tmask(:,:,1) * zconv ) 
    200  
    201          zsmv_b = glob_sum( SUM( smv_i * rhoic            , dim=3 ) * e12t * tmask(:,:,1) * zconv ) 
     197            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv ) 
     198 
     199         zvi_b  = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t * tmask(:,:,1) * zconv ) 
     200 
     201         zsmv_b = glob_sum( SUM( smv_i * rhoic            , dim=3 ) * e1e2t * tmask(:,:,1) * zconv ) 
    202202 
    203203         zei_b  = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  & 
    204204            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    & 
    205                             ) * e12t * tmask(:,:,1) * zconv ) 
     205                            ) * e1e2t * tmask(:,:,1) * zconv ) 
    206206 
    207207      ELSEIF( icount == 1 ) THEN 
     
    210210         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    211211            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &  
    212             &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 
     212            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 
    213213 
    214214         ! water flux 
    215215         zfw  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
    216216            &                wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
    217             &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfw_b 
     217            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfw_b 
    218218 
    219219         ! heat flux 
    220220         zft  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
    221221            &              - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
    222             &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zft_b 
     222            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zft_b 
    223223  
    224224         ! outputs 
    225225         zvi  = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 )  & 
    226             &                    * e12t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday 
     226            &                    * e1e2t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday 
    227227 
    228228         zsmv = ( ( glob_sum( SUM( smv_i * rhoic            , dim=3 )  & 
    229             &                    * e12t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday 
     229            &                    * e1e2t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday 
    230230 
    231231         zei  =   glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  & 
    232232            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    & 
    233             &                ) * e12t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft 
     233            &                ) * e1e2t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft 
    234234 
    235235         ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative 
    236          zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e12t * tmask(:,:,1) * zconv ) * rday  
    237          zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e12t * tmask(:,:,1) * zconv ) 
     236         zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e1e2t * tmask(:,:,1) * zconv ) * rday  
     237         zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e1e2t * tmask(:,:,1) * zconv ) 
    238238 
    239239         zvmin = glob_min( v_i ) 
     
    242242 
    243243         ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice)  
    244          zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2 
     244         zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2 
    245245         zv_sill = zarea * 2.5e-5 
    246246         zs_sill = zarea * 25.e-5 
     
    286286#if ! defined key_bdy 
    287287      ! heat flux 
    288       zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e12t * tmask(:,:,1) * zconv )  
     288      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e1e2t * tmask(:,:,1) * zconv )  
    289289      ! salt flux 
    290       zsfx  = glob_sum( ( sfx + diag_smvi ) * e12t * tmask(:,:,1) * zconv ) * rday 
     290      zsfx  = glob_sum( ( sfx + diag_smvi ) * e1e2t * tmask(:,:,1) * zconv ) * rday 
    291291      ! water flux 
    292       zvfx  = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e12t * tmask(:,:,1) * zconv ) * rday 
     292      zvfx  = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t * tmask(:,:,1) * zconv ) * rday 
    293293 
    294294      ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice)  
    295       zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2 
     295      zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2 
    296296      zv_sill = zarea * 2.5e-5 
    297297      zs_sill = zarea * 25.e-5 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90

    r5167 r5737  
    306306               WRITE(numout,*) ' - Cell values ' 
    307307               WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    308                WRITE(numout,*) ' cell area     : ', e12t(ji,jj) 
     308               WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj) 
    309309               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)        
    310310               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)        
     
    350350               WRITE(numout,*) ' - Cell values ' 
    351351               WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    352                WRITE(numout,*) ' cell area     : ', e12t(ji,jj) 
     352               WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj) 
    353353               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)        
    354354               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)        
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r5215 r5737  
    7171 
    7272      ! 1/area 
    73       z1_area = 1._wp / MAX( glob_sum( e12t(:,:) * tmask(:,:,1) ), epsi06 ) 
    74  
    75       rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e12t(:,:) * tmask(:,:,1) ) - epsi06 ) ) 
     73      z1_area = 1._wp / MAX( glob_sum( e1e2t(:,:) * tmask(:,:,1) ), epsi06 ) 
     74 
     75      rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e1e2t(:,:) * tmask(:,:,1) ) - epsi06 ) ) 
    7676      ! ----------------------- ! 
    7777      ! 1 -  Content variations ! 
    7878      ! ----------------------- ! 
    79       zbg_ivo = glob_sum( vt_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume ice  
    80       zbg_svo = glob_sum( vt_s(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume snow 
    81       zbg_are = glob_sum( at_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! area 
    82       zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) )       ! mean salt content 
    83       zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e12t(:,:) * tmask(:,:,1) )  ! mean temp content 
    84  
    85       !zbg_ihc = glob_sum( et_i(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 
    86       !zbg_shc = glob_sum( et_s(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 
     79      zbg_ivo = glob_sum( vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume ice  
     80      zbg_svo = glob_sum( vt_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume snow 
     81      zbg_are = glob_sum( at_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! area 
     82      zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e1e2t(:,:) * tmask(:,:,1) )       ! mean salt content 
     83      zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) )  ! mean temp content 
     84 
     85      !zbg_ihc = glob_sum( et_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 
     86      !zbg_shc = glob_sum( et_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 
    8787 
    8888      ! Volume 
    8989      ztmp = rswitch * z1_area * r1_rau0 * rday 
    90       zbg_vfx     = ztmp * glob_sum(     emp(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    91       zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    92       zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    93       zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    94       zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    95       zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    96       zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    97       zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    98       zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    99       zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    100       zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     90      zbg_vfx     = ztmp * glob_sum(     emp(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     91      zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     92      zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     93      zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     94      zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     95      zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     96      zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     97      zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     98      zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     99      zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     100      zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    101101 
    102102      ! Salt 
    103       zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    104       zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    105       zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    106       zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    107  
    108       zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    109       zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    110       zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    111       zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    112       zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     103      zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     104      zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     105      zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     106      zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     107 
     108      zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     109      zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     110      zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     111      zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
     112      zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    113113 
    114114      ! Heat budget 
    115       zbg_ihc      = glob_sum( et_i(:,:) * e12t(:,:) * 1.e-20 ) ! ice heat content  [1.e20 J] 
    116       zbg_shc      = glob_sum( et_s(:,:) * e12t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J] 
    117       zbg_hfx_dhc  = glob_sum( diag_heat(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    118       zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    119  
    120       zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    121       zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    122       zbg_hfx_res  = glob_sum( hfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    123       zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    124       zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    125       zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    126       zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    127       zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    128       zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    129       zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    130       zbg_hfx_out  = glob_sum( hfx_out(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    131       zbg_hfx_in   = glob_sum(  hfx_in(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     115      zbg_ihc      = glob_sum( et_i(:,:) * e1e2t(:,:) ) * 1.e-20 ! ice heat content  [1.e20 J] 
     116      zbg_shc      = glob_sum( et_s(:,:) * e1e2t(:,:) ) * 1.e-20 ! snow heat content [1.e20 J] 
     117      zbg_hfx_dhc  = glob_sum( diag_heat(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
     118      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
     119 
     120      zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
     121      zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
     122      zbg_hfx_res  = glob_sum( hfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
     123      zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
     124      zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
     125      zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
     126      zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
     127      zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
     128      zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
     129      zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
     130      zbg_hfx_out  = glob_sum( hfx_out(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
     131      zbg_hfx_in   = glob_sum(  hfx_in(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    132132     
    133133      ! --------------------------------------------- ! 
    134134      ! 2 - Trends due to forcing and ice growth/melt ! 
    135135      ! --------------------------------------------- ! 
    136       z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes 
    137       z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * e12t(:,:) * tmask(:,:,1) ) ! salt fluxes 
     136      z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes 
     137      z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! salt fluxes 
    138138      z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 
    139139                          &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + & 
    140                           &     wfx_sub(:,:) ) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes 
     140                          &     wfx_sub(:,:) ) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes 
    141141      ! 
    142142      frc_vol  = frc_vol  + z_frc_vol  * rdt_ice 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r5123 r5737  
    191191         CALL prt_ctl(tab2d_1=delta_i   , clinfo1=' lim_dyn  : delta_i   :') 
    192192         CALL prt_ctl(tab2d_1=strength  , clinfo1=' lim_dyn  : strength  :') 
    193          CALL prt_ctl(tab2d_1=e12t      , clinfo1=' lim_dyn  : cell area :') 
     193         CALL prt_ctl(tab2d_1=e1e2t     , clinfo1=' lim_dyn  : cell area :') 
    194194         CALL prt_ctl(tab2d_1=at_i      , clinfo1=' lim_dyn  : at_i      :') 
    195195         CALL prt_ctl(tab2d_1=vt_i      , clinfo1=' lim_dyn  : vt_i      :') 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r5429 r5737  
    7676         DO jj = 2, jpjm1   
    7777            DO ji = fs_2 , fs_jpim1   ! vector opt. 
    78                efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e12t(ji,jj) 
     78               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e1e2t(ji,jj) 
    7979            END DO 
    8080         END DO 
     
    107107         DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes 
    108108            DO ji = fs_2 , fs_jpim1   ! vector opt.  
    109                zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 
     109               zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj) 
    110110            END DO 
    111111         END DO 
     
    149149      DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes 
    150150         DO ji = fs_2 , fs_jpim1   ! vector opt.  
    151             zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 
     151            zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj) 
    152152            ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) ) 
    153153         END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r5202 r5737  
    377377         CALL prt_ctl_info(' - Cell values : ') 
    378378         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    379          CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_me  : cell area :') 
     379         CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_itd_me  : cell area :') 
    380380         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me  : at_i      :') 
    381381         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me  : vt_i      :') 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r5429 r5737  
    355355               divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
    356356                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
    357                   &            ) * r1_e12t(ji,jj) 
     357                  &            ) * r1_e1e2t(ji,jj) 
    358358 
    359359               zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   & 
    360360                  &         - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
    361                   &         ) * r1_e12t(ji,jj) 
     361                  &         ) * r1_e1e2t(ji,jj) 
    362362 
    363363               ! 
    364364               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    365365                  &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    366                   &         ) * r1_e12f(ji,jj) * ( 2._wp - fmask(ji,jj,1) )   & 
     366                  &         ) * r1_e1e2f(ji,jj) * ( 2._wp - fmask(ji,jj,1) )   & 
    367367                  &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 
    368368 
     
    386386               zdst          = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )   & 
    387387                  &            + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1)   & 
    388                   &            ) * r1_e12t(ji,jj) 
     388                  &            ) * r1_e1e2t(ji,jj) 
    389389 
    390390               delta          = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )   
     
    394394               zddc  = (  ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  & 
    395395                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  & 
    396                   &    ) * r1_e12f(ji,jj) 
     396                  &    ) * r1_e1e2f(ji,jj) 
    397397 
    398398               zdtc  = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  & 
    399399                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  & 
    400                   &    ) * r1_e12f(ji,jj) 
     400                  &    ) * r1_e1e2f(ji,jj) 
    401401 
    402402               zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl 
     
    423423                  &             + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj)          & 
    424424                  &             + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj)  & 
    425                   &                ) * r1_e12u(ji,jj) 
     425                  &                ) * r1_e1e2u(ji,jj) 
    426426               ! contribution of zs1, zs2 and zs12 to zf2 
    427427               zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)  & 
    428428                  &             - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj)          & 
    429429                  &             + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj)  & 
    430                   &               )  * r1_e12v(ji,jj) 
     430                  &               )  * r1_e1e2v(ji,jj) 
    431431            END DO 
    432432         END DO 
     
    607607               divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj  ) * u_ice(ji-1,jj  )   & 
    608608                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji  ,jj-1) * v_ice(ji  ,jj-1)   & 
    609                   &            ) * r1_e12t(ji,jj) 
     609                  &            ) * r1_e1e2t(ji,jj) 
    610610 
    611611               zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)  & 
    612612                  &          -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)  & 
    613                   &         ) * r1_e12t(ji,jj) 
     613                  &         ) * r1_e1e2t(ji,jj) 
    614614               ! 
    615615               ! SB modif because ocean has no slip boundary condition  
    616616               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  & 
    617617                  &          +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  & 
    618                   &         ) * r1_e12f(ji,jj) * ( 2.0 - fmask(ji,jj,1) )                                     & 
     618                  &         ) * r1_e1e2f(ji,jj) * ( 2.0 - fmask(ji,jj,1) )                                     & 
    619619                  &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 
    620620 
    621621               zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )    & 
    622                   &   + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1) ) * r1_e12t(ji,jj) 
     622                  &   + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1) ) * r1_e1e2t(ji,jj) 
    623623 
    624624               delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )   
     
    637637         DO ji = fs_2, fs_jpim1 
    638638            zdst           = (  e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)  &    
    639                &              + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e12t(ji,jj)  
     639               &              + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e1e2t(ji,jj)  
    640640            shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst ) 
    641641         END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r5407 r5737  
    325325         CALL prt_ctl_info(' - Cell values : ') 
    326326         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    327          CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_thd  : cell area :') 
     327         CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_thd  : cell area :') 
    328328         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd  : at_i      :') 
    329329         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd  : vt_i      :') 
     
    382382         CALL prt_ctl_info(' - Cell values : ') 
    383383         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    384          CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_th  : cell area :') 
     384         CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_itd_th  : cell area :') 
    385385         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th  : at_i      :') 
    386386         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th  : vt_i      :') 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r5202 r5737  
    9595      ENDIF 
    9696 
    97       zsm(:,:) = e12t(:,:) 
     97      zsm(:,:) = e1e2t(:,:) 
    9898       
    9999      !                             !-------------------------------------! 
     
    162162         ! transported fields                                         
    163163         !------------------------- 
    164          z0opw(:,:,1) = ato_i(:,:) * e12t(:,:)             ! Open water area  
    165          DO jl = 1, jpl 
    166             z0snw (:,:,jl)  = v_s  (:,:,jl) * e12t(:,:)    ! Snow volume 
    167             z0ice(:,:,jl)   = v_i  (:,:,jl) * e12t(:,:)    ! Ice  volume 
    168             z0ai  (:,:,jl)  = a_i  (:,:,jl) * e12t(:,:)    ! Ice area 
    169             z0smi (:,:,jl)  = smv_i(:,:,jl) * e12t(:,:)    ! Salt content 
    170             z0oi (:,:,jl)   = oa_i (:,:,jl) * e12t(:,:)    ! Age content 
    171             z0es (:,:,jl)   = e_s  (:,:,1,jl) * e12t(:,:)  ! Snow heat content 
     164         z0opw(:,:,1) = ato_i(:,:) * e1e2t(:,:)             ! Open water area  
     165         DO jl = 1, jpl 
     166            z0snw (:,:,jl)  = v_s  (:,:,  jl) * e1e2t(:,:)  ! Snow volume 
     167            z0ice(:,:,jl)   = v_i  (:,:,  jl) * e1e2t(:,:)  ! Ice  volume 
     168            z0ai  (:,:,jl)  = a_i  (:,:,  jl) * e1e2t(:,:)  ! Ice area 
     169            z0smi (:,:,jl)  = smv_i(:,:,  jl) * e1e2t(:,:)  ! Salt content 
     170            z0oi (:,:,jl)   = oa_i (:,:,  jl) * e1e2t(:,:)  ! Age content 
     171            z0es (:,:,jl)   = e_s  (:,:,1,jl) * e1e2t(:,:)  ! Snow heat content 
    172172            DO jk = 1, nlay_i 
    173                z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e12t(:,:) ! Ice  heat content 
     173               z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content 
    174174            END DO 
    175175         END DO 
     
    263263         ! Recover the properties from their contents 
    264264         !------------------------------------------- 
    265          ato_i(:,:) = z0opw(:,:,1) * r1_e12t(:,:) 
    266          DO jl = 1, jpl 
    267             v_i  (:,:,jl)   = z0ice(:,:,jl) * r1_e12t(:,:) 
    268             v_s  (:,:,jl)   = z0snw(:,:,jl) * r1_e12t(:,:) 
    269             smv_i(:,:,jl)   = z0smi(:,:,jl) * r1_e12t(:,:) 
    270             oa_i (:,:,jl)   = z0oi (:,:,jl) * r1_e12t(:,:) 
    271             a_i  (:,:,jl)   = z0ai (:,:,jl) * r1_e12t(:,:) 
    272             e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e12t(:,:) 
     265         ato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:) 
     266         DO jl = 1, jpl 
     267            v_i  (:,:,  jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) 
     268            v_s  (:,:,  jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) 
     269            smv_i(:,:,  jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) 
     270            oa_i (:,:,  jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) 
     271            a_i  (:,:,  jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) 
     272            e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e1e2t(:,:) 
    273273            DO jk = 1, nlay_i 
    274                e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e12t(:,:) 
     274               e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) 
    275275            END DO 
    276276         END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    r5215 r5737  
    146146         CALL prt_ctl_info(' - Cell values : ') 
    147147         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    148          CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update1  : cell area   :') 
     148         CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' lim_update1  : cell area   :') 
    149149         CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update1  : at_i        :') 
    150150         CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update1  : vt_i        :') 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    r5410 r5737  
    191191         CALL prt_ctl_info(' - Cell values : ') 
    192192         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    193          CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update2  : cell area   :') 
     193         CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' lim_update2  : cell area   :') 
    194194         CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update2  : at_i        :') 
    195195         CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update2  : vt_i        :') 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r5656 r5737  
    210210               DO jj = j1,j2-1 
    211211                  DO ji = i1,i2-1 
    212                      zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    213                      zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     212                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
     213                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
    214214                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) )  
    215215                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
     
    239239 
    240240                     IF (.NOT. tabspongedone_tsn(ji,jj)) THEN  
    241                         zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) 
     241                        zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) 
    242242                        ! horizontal diffusive trends 
    243243                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) 
     
    290290            DO jj = j1,j2 
    291291               DO ji = i1+1,i2   ! vector opt. 
    292                   zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
     292                  zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
    293293                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*fse3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) & 
    294294                                     &   -e2u(ji-1,jj)*fse3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr 
     
    298298            DO jj = j1,j2-1 
    299299               DO ji = i1,i2   ! vector opt. 
    300                   zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
     300                  zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
    301301                  rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) & 
    302302                                       +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) &  
     
    396396            DO jj = j1+1,j2 
    397397               DO ji = i1,i2   ! vector opt. 
    398                   zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
     398                  zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
    399399                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  & 
    400400                                     &  -e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr 
     
    403403            DO jj = j1,j2 
    404404               DO ji = i1,i2-1   ! vector opt. 
    405                   zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
     405                  zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
    406406                  rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) &  
    407407                                    &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk) & 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

    r5656 r5737  
    7474               DO jj = j1,j2-1 
    7575                  DO ji = i1,i2-1 
    76                      zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    77                      zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     76                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
     77                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
    7878                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
    7979                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
     
    8585 
    8686                     IF (.NOT. tabspongedone_trn(ji,jj)) THEN  
    87                         zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,jk) 
     87                        zbtr = r1_e1e2t(ji,jj) / fse3t(ji,jj,jk) 
    8888                        ! horizontal diffusive trends 
    8989                        ztra = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  ) + ztv(ji,jj) - ztv(ji  ,jj-1)  ) 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OFF_SRC/domrea.F90

    r5504 r5737  
    44   !! Ocean initialization : domain initialization 
    55   !!============================================================================== 
     6   !! History :  OPA  ! 1990-10  (C. Levy - G. Madec)  Original code 
     7   !!                 ! 1992-01  (M. Imbard) insert time step initialization 
     8   !!                 ! 1996-06  (G. Madec) generalized vertical coordinate  
     9   !!                 ! 1997-02  (G. Madec) creation of domwri.F 
     10   !!                 ! 2001-05  (E.Durand - G. Madec) insert closed sea 
     11   !!  NEMO      1.0  ! 2002-08  (G. Madec)  F90: Free form and module 
     12   !!---------------------------------------------------------------------- 
    613 
    714   !!---------------------------------------------------------------------- 
     
    1017   !!   dom_ctl        : control print for the ocean domain 
    1118   !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    1319   USE oce             !  
     20   USE trc_oce         ! shared ocean/biogeochemical variables 
    1421   USE dom_oce         ! ocean space and time domain 
    1522   USE phycst          ! physical constants 
     23   USE domstp          ! domain: set the time-step 
     24   ! 
    1625   USE in_out_manager  ! I/O manager 
    1726   USE lib_mpp         ! distributed memory computing library 
    18  
    19    USE domstp          ! domain: set the time-step 
    20  
    2127   USE lbclnk          ! lateral boundary condition - MPP exchanges 
    22    USE trc_oce         ! shared ocean/biogeochemical variables 
    2328   USE wrk_nemo   
    2429    
     
    2631   PRIVATE 
    2732 
    28    !! * Routine accessibility 
    29    PUBLIC dom_rea       ! called by opa.F90 
     33   PUBLIC   dom_rea    ! called by nemogcm.F90 
    3034 
    3135   !! * Substitutions 
     
    3337#  include "vectopt_loop_substitute.h90" 
    3438   !!---------------------------------------------------------------------- 
    35    !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
     39   !! NEMO/OFF 3.7 , NEMO Consortium (2015) 
    3640   !! $Id$ 
    3741   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3842   !!---------------------------------------------------------------------- 
    39  
    4043CONTAINS 
    4144 
     
    5154      !!      - dom_stp: defined the model time step 
    5255      !!      - dom_rea: read the meshmask file if nmsh=1 
    53       !! 
    54       !! History : 
    55       !!        !  90-10  (C. Levy - G. Madec)  Original code 
    56       !!        !  91-11  (G. Madec) 
    57       !!        !  92-01  (M. Imbard) insert time step initialization 
    58       !!        !  96-06  (G. Madec) generalized vertical coordinate  
    59       !!        !  97-02  (G. Madec) creation of domwri.F 
    60       !!        !  01-05  (E.Durand - G. Madec) insert closed sea 
    61       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    62       !!---------------------------------------------------------------------- 
    63       !! * Local declarations 
    64       INTEGER ::   jk                ! dummy loop argument 
    65       INTEGER ::   iconf = 0         ! temporary integers 
    66       !!---------------------------------------------------------------------- 
    67  
     56      !!---------------------------------------------------------------------- 
     57      INTEGER ::   jk          ! dummy loop index 
     58      INTEGER ::   iconf = 0   ! local integers 
     59      !!---------------------------------------------------------------------- 
     60      ! 
    6861      IF(lwp) THEN 
    6962         WRITE(numout,*) 
     
    7164         WRITE(numout,*) '~~~~~~~~' 
    7265      ENDIF 
    73  
     66      ! 
    7467      CALL dom_nam      ! read namelist ( namrun, namdom, namcla ) 
    7568      CALL dom_zgr      ! Vertical mesh and bathymetry option 
    7669      CALL dom_grd      ! Create a domain file 
    77  
    78      ! 
    79       ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines 
    80       !        but could be usefull in many other routines 
    81       e12t    (:,:) = e1t(:,:) * e2t(:,:) 
    82       e1e2t   (:,:) = e1t(:,:) * e2t(:,:) 
    83       e12u    (:,:) = e1u(:,:) * e2u(:,:) 
    84       e12v    (:,:) = e1v(:,:) * e2v(:,:) 
    85       e12f    (:,:) = e1f(:,:) * e2f(:,:) 
    86       r1_e12t (:,:) = 1._wp    / e12t(:,:) 
    87       r1_e12u (:,:) = 1._wp    / e12u(:,:) 
    88       r1_e12v (:,:) = 1._wp    / e12v(:,:) 
    89       r1_e12f (:,:) = 1._wp    / e12f(:,:) 
    90       re2u_e1u(:,:) = e2u(:,:) / e1u(:,:) 
    91       re1v_e2v(:,:) = e1v(:,:) / e2v(:,:) 
    92       ! 
    93       hu(:,:) = 0._wp                          ! Ocean depth at U- and V-points 
     70      ! 
     71      !                                      ! associated horizontal metrics 
     72      ! 
     73      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:) 
     74      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:) 
     75      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:) 
     76      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:) 
     77      ! 
     78      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 
     79      e1e2u (:,:) = e1u(:,:) * e2u(:,:)   ;   r1_e1e2u(:,:) = 1._wp / e1e2u(:,:) 
     80      e1e2v (:,:) = e1v(:,:) * e2v(:,:)   ;   r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 
     81      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:) 
     82      !    
     83      e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 
     84      e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 
     85      ! 
     86      hu(:,:) = 0._wp                        ! Ocean depth at U- and V-points 
    9487      hv(:,:) = 0._wp 
    9588      DO jk = 1, jpk 
     
    10093      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 
    10194      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 
    102  
     95      ! 
    10396      CALL dom_stp      ! Time step 
    10497      CALL dom_msk      ! Masks 
    10598      CALL dom_ctl      ! Domain control 
    106  
     99      ! 
    107100   END SUBROUTINE dom_rea 
     101 
    108102 
    109103   SUBROUTINE dom_nam 
     
    118112      !!---------------------------------------------------------------------- 
    119113      USE ioipsl 
    120       INTEGER  ::   ios                 ! Local integer output status for namelist read 
     114      INTEGER  ::   ios   ! Local integer output status for namelist read 
     115      ! 
    121116      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               & 
    122117         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
     
    178173      nstocklist = nn_stocklist 
    179174      nwrite = nn_write 
    180  
    181  
     175      ! 
    182176      !                             ! control of output frequency 
    183177      IF ( nstock == 0 .OR. nstock > nitend ) THEN 
     
    321315   END SUBROUTINE dom_nam 
    322316 
     317 
    323318   SUBROUTINE dom_zgr 
    324319      !!---------------------------------------------------------------------- 
     
    374369   END SUBROUTINE dom_zgr 
    375370 
     371 
    376372   SUBROUTINE dom_ctl 
    377373      !!---------------------------------------------------------------------- 
     
    382378      !! ** Method  :   compute and print extrema of masked scale factors 
    383379      !! 
    384       !! History : 
    385       !!   8.5  !  02-08  (G. Madec)    Original code 
    386       !!---------------------------------------------------------------------- 
    387       !! * Local declarations 
     380      !!---------------------------------------------------------------------- 
    388381      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 
    389382      INTEGER, DIMENSION(2) ::   iloc      !  
     
    421414         ijma2 = iloc(2) + njmpp - 1 
    422415      ENDIF 
    423  
     416      ! 
    424417      IF(lwp) THEN 
    425418         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1 
     
    428421         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2 
    429422      ENDIF 
    430  
     423      ! 
    431424   END SUBROUTINE dom_ctl 
     425 
    432426 
    433427   SUBROUTINE dom_grd 
     
    538532         CALL iom_get( inum2, jpdom_data, 'facvolt', facvol ) 
    539533#endif 
    540  
    541534         !                                                         ! horizontal mesh (inum3) 
    542535         CALL iom_get( inum3, jpdom_data, 'glamt', glamt ) 
     
    756749      !!                                     (min value = 1 over land) 
    757750      !!---------------------------------------------------------------------- 
    758       ! 
    759751      INTEGER ::   ji, jj   ! dummy loop indices 
    760752      REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 
     
    785777   END SUBROUTINE zgr_bot_level 
    786778 
     779 
    787780   SUBROUTINE dom_msk 
    788781      !!--------------------------------------------------------------------- 
     
    799792      !!               tpol     : ??? 
    800793      !!---------------------------------------------------------------------- 
    801       ! 
    802       INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
    803       INTEGER  ::   iif, iil, ijf, ijl       ! local integers 
     794      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
     795      INTEGER  ::   iif, iil, ijf, ijl   ! local integers 
    804796      INTEGER, POINTER, DIMENSION(:,:) ::  imsk  
    805       ! 
    806797      !!--------------------------------------------------------------------- 
    807798       
     
    853844      ! 3. Ocean/land mask at wu-, wv- and w points  
    854845      !---------------------------------------------- 
    855       wmask (:,:,1) = tmask(:,:,1) ! ???????? 
    856       wumask(:,:,1) = umask(:,:,1) ! ???????? 
    857       wvmask(:,:,1) = vmask(:,:,1) ! ???????? 
    858       DO jk=2,jpk 
    859          wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1) 
    860          wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1)    
    861          wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1) 
     846      wmask (:,:,1) = tmask(:,:,1)        ! surface value 
     847      wumask(:,:,1) = umask(:,:,1)  
     848      wvmask(:,:,1) = vmask(:,:,1) 
     849      DO jk = 2, jpk                      ! deeper value 
     850         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 
     851         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)    
     852         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 
    862853      END DO 
    863854      ! 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r5385 r5737  
    510510               zv  = pv(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) 
    511511               zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) 
    512                zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     512               zet = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    513513               zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet  
    514514            END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r5541 r5737  
    444444                         + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * v_bkginc(ji  ,jj  ,jk)     & 
    445445                         - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * v_bkginc(ji  ,jj-1,jk)  )  & 
    446                          / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     446                         / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    447447                  END DO 
    448448               END DO 
     
    452452               DO jj = 2, jpjm1 
    453453                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    454                      u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1t(ji+1,jj)*e2t(ji+1,jj) * hdiv(ji+1,jj)   & 
    455                                                                         - e1t(ji  ,jj)*e2t(ji  ,jj) * hdiv(ji  ,jj) ) & 
    456                                                                       / e1u(ji,jj) * umask(ji,jj,jk)  
    457                      v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1t(ji,jj+1)*e2t(ji,jj+1) * hdiv(ji,jj+1)   & 
    458                                                                         - e1t(ji,jj  )*e2t(ji,jj  ) * hdiv(ji,jj  ) ) & 
    459                                                                       / e2v(ji,jj) * vmask(ji,jj,jk)  
     454                     u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji+1,jj) * hdiv(ji+1,jj)   & 
     455                                                                        - e1e2t(ji  ,jj) * hdiv(ji  ,jj) ) & 
     456                                                                      * r1_e1u(ji,jj) * umask(ji,jj,jk)  
     457                     v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji,jj+1) * hdiv(ji,jj+1)   & 
     458                                                                        - e1e2t(ji,jj  ) * hdiv(ji,jj  ) ) & 
     459                                                                      * r1_e2v(ji,jj) * vmask(ji,jj,jk)  
    460460                  END DO 
    461461               END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r5643 r5737  
    9191      ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 
    9292      ! ----------------------------------------------------------------------- 
    93       z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0 
     93      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 
    9494      IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain 
    9595 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r5253 r5737  
    237237      IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 
    238238 
    239       area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) 
     239      area(:,:) = e1e2t(:,:) * tmask_i(:,:) 
    240240 
    241241      area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot ) 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r5506 r5737  
    7474         a_salb   = 0.e0 ! valeur de sal au debut de la simulation 
    7575         ! sshb used because diafwb called after tranxt (i.e. after the swap) 
    76          a_sshb = SUM( e1t(:,:) * e2t(:,:) * sshb(:,:) * tmask_i(:,:) ) 
     76         a_sshb = SUM( e1e2t(:,:) * sshb(:,:) * tmask_i(:,:) ) 
    7777         IF( lk_mpp )   CALL mpp_sum( a_sshb )      ! sum over the global domain 
    7878 
     
    8080            DO jj = 2, jpjm1 
    8181               DO ji = fs_2, fs_jpim1   ! vector opt. 
    82                   zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     82                  zwei  = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    8383                  a_salb = a_salb + ( tsb(ji,jj,jk,jp_sal) - zsm0 ) * zwei 
    8484               END DO 
     
    8888      ENDIF 
    8989       
    90       a_fwf    = SUM( e1t(:,:) * e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) )  
     90      a_fwf    = SUM( e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) )  
    9191      IF( lk_mpp )   CALL mpp_sum( a_fwf    )       ! sum over the global domain 
    9292 
     
    9898         zfwfnew = 0.e0 
    9999         ! Mean sea level at nitend 
    100          a_sshn = SUM( e1t(:,:) * e2t(:,:) * sshn(:,:) * tmask_i(:,:) ) 
     100         a_sshn = SUM( e1e2t(:,:) * sshn(:,:) * tmask_i(:,:) ) 
    101101         IF( lk_mpp )   CALL mpp_sum( a_sshn )      ! sum over the global domain 
    102          zarea  = SUM( e1t(:,:) * e2t(:,:) *             tmask_i(:,:) ) 
     102         zarea  = SUM( e1e2t(:,:) *             tmask_i(:,:) ) 
    103103         IF( lk_mpp )   CALL mpp_sum( zarea  )      ! sum over the global domain 
    104104          
     
    106106            DO jj = 2, jpjm1 
    107107               DO ji = fs_2, fs_jpim1   ! vector opt. 
    108                   zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     108                  zwei  = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    109109                  a_saln = a_saln + ( tsn(ji,jj,jk,jp_sal) - zsm0 ) * zwei 
    110110                  zvol  = zvol  + zwei 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r5566 r5737  
    232232      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
    233233         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    234          z2d(:,:) = rau0 * e12t(:,:) 
     234         z2d(:,:) = rau0 * e1e2t(:,:) 
    235235         DO jk = 1, jpk 
    236236            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
     
    247247         DO jj = 2, jpjm1                                    ! sst gradient 
    248248            DO ji = fs_2, fs_jpim1   ! vector opt. 
    249                zztmp      = tsn(ji,jj,1,jp_tem) 
    250                zztmpx     = ( tsn(ji+1,jj  ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) / e1u(ji-1,jj  ) 
    251                zztmpy     = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) / e2v(ji  ,jj-1) 
     249               zztmp  = tsn(ji,jj,1,jp_tem) 
     250               zztmpx = ( tsn(ji+1,jj  ,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) * r1_e1u(ji-1,jj  ) 
     251               zztmpy = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) * r1_e2v(ji  ,jj-1) 
    252252               z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & 
    253253                  &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
     
    657657          
    658658         clmx ="l_max(only(x))"    ! max index on a period 
    659          CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX  
    660             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout ) 
     659!         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX  
     660!            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout ) 
    661661#if defined key_diahth 
    662662         CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth 
     
    892892            DO jj = 2, jpjm1 
    893893               DO ji = fs_2, fs_jpim1  ! vector opt. 
    894                   zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2v(ji,jj) + & 
    895                        &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 
     894                  zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))*r1_e2v(ji,jj) + & 
     895                       &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))*r1_e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 
    896896               END DO 
    897897            END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r5123 r5737  
    77   !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate  
    88   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level 
    9    !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
     9   !!            3.4  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    1010   !!            3.5  ! 2012     (S. Mocavero, I. Epicoco) Add arrays associated 
    1111   !!                             to the optimization of BDY communications 
     12   !!            3.7  ! 2015-11  (G. Madec) introduce surface and scale factor ratio 
    1213   !!---------------------------------------------------------------------- 
    1314 
     
    158159   !! horizontal curvilinear coordinate and scale factors 
    159160   !! --------------------------------------------------------------------- 
    160    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamt, glamu   !: longitude of t-, u-, v- and f-points (degre) 
    161    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamv, glamf   !: 
    162    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphit, gphiu   !: latitude  of t-, u-, v- and f-points (degre) 
    163    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphiv, gphif   !: 
    164    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1t, e2t, r1_e1t, r1_e2t   !: horizontal scale factors and inverse at t-point (m) 
    165    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1u, e2u, r1_e1u, r1_e2u   !: horizontal scale factors and inverse at u-point (m) 
    166    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1v, e2v, r1_e1v, r1_e2v   !: horizontal scale factors and inverse at v-point (m) 
    167    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1f, e2f, r1_e1f, r1_e2f   !: horizontal scale factors and inverse at f-point (m) 
    168    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1e2t          !: surface at t-point (m2) 
    169    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ff             !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 
     161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   glamt , glamu, glamv , glamf    !: longitude at t, u, v, f-points [degree] 
     162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gphit , gphiu, gphiv , gphif    !: latitude  at t, u, v, f-points [degree] 
     163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1t   , e2t  , r1_e1t, r1_e2t   !: t-point horizontal scale factors    [m] 
     164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1u   , e2u  , r1_e1u, r1_e2u   !: horizontal scale factors at u-point [m] 
     165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1v   , e2v  , r1_e1v, r1_e2v   !: horizontal scale factors at v-point [m] 
     166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m] 
     167   ! 
     168   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point 
     169   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point 
     170   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point 
     171   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
     172   ! 
     173   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff                              !: coriolis factor                   [1/s] 
    170174 
    171175   !!---------------------------------------------------------------------- 
     
    216220   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0           !: reference depth at t-       points (meters) 
    217221   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0 , hv_0    !: reference depth at u- and v-points (meters) 
    218    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   re2u_e1u       !: scale factor coeffs at u points (e2u/e1u) 
    219    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   re1v_e2v       !: scale factor coeffs at v points (e1v/e2v) 
    220    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12t , r1_e12t !: horizontal cell surface and inverse at t points 
    221    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12u , r1_e12u !: horizontal cell surface and inverse at u points 
    222    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12v , r1_e12v !: horizontal cell surface and inverse at v points 
    223    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12f , r1_e12f !: horizontal cell surface and inverse at f points 
    224222 
    225223   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 
     
    333331   INTEGER FUNCTION dom_oce_alloc() 
    334332      !!---------------------------------------------------------------------- 
    335       INTEGER, DIMENSION(12) :: ierr 
     333      INTEGER, DIMENSION(13) :: ierr 
    336334      !!---------------------------------------------------------------------- 
    337335      ierr(:) = 0 
     
    346344         &      tpol(jpiglo)  , fpol(jpiglo)                               , STAT=ierr(2) ) 
    347345         ! 
    348       ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,   &  
    349          &      glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,   &   
    350          &      glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,   &   
    351          &      glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,   & 
    352          &      e1e2t(jpi,jpj) , ff   (jpi,jpj) , STAT=ierr(3) )      
     346      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     & 
     347         &      gphit(jpi,jpj) ,    gphiu(jpi,jpj) ,  gphiv(jpi,jpj) ,  gphif(jpi,jpj) ,     & 
     348         &       e1t (jpi,jpj) ,     e2t (jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,     & 
     349         &       e1u (jpi,jpj) ,     e2u (jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,     & 
     350         &       e1v (jpi,jpj) ,     e2v (jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,     & 
     351         &       e1f (jpi,jpj) ,     e2f (jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,     & 
     352         &      e1e2t(jpi,jpj) , r1_e1e2t(jpi,jpj)                                     ,     & 
     353         &      e1e2u(jpi,jpj) , r1_e1e2u(jpi,jpj) , e2_e1u(jpi,jpj)                   ,     & 
     354         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     & 
     355         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     & 
     356         &        ff (jpi,jpj)                                                         , STAT=ierr(3) ) 
    353357         ! 
    354358      ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) ,                         & 
     
    364368         &      gdept_b (jpi,jpj,jpk) ,gdepw_b(jpi,jpj,jpk) , e3w_b (jpi,jpj,jpk) ,                           & 
    365369         &      e3t_a   (jpi,jpj,jpk) , e3u_a (jpi,jpj,jpk) , e3v_a (jpi,jpj,jpk) ,                           & 
    366          &      ehu_a    (jpi,jpj)    , ehv_a  (jpi,jpj),                                                     & 
    367          &      ehur_a   (jpi,jpj)    , ehvr_a (jpi,jpj),                                                     & 
    368          &      ehu_b    (jpi,jpj)    , ehv_b  (jpi,jpj),                                                     & 
    369          &      ehur_b   (jpi,jpj)    , ehvr_b (jpi,jpj),                                  STAT=ierr(5) )                           
    370 #endif 
    371          ! 
    372       ALLOCATE( hu      (jpi,jpj) , hur     (jpi,jpj) , hu_0(jpi,jpj) , ht_0  (jpi,jpj) ,     & 
    373          &      hv      (jpi,jpj) , hvr     (jpi,jpj) , hv_0(jpi,jpj) , ht    (jpi,jpj) ,     & 
    374          &      re2u_e1u(jpi,jpj) , re1v_e2v(jpi,jpj) ,                                       & 
    375          &      e12t    (jpi,jpj) , r1_e12t (jpi,jpj) ,                                       & 
    376          &      e12u    (jpi,jpj) , r1_e12u (jpi,jpj) ,                                       & 
    377          &      e12v    (jpi,jpj) , r1_e12v (jpi,jpj) ,                                       & 
    378          &      e12f    (jpi,jpj) , r1_e12f (jpi,jpj) ,                                   STAT=ierr(6)  ) 
     370         &      ehu_a   (jpi,jpj)     , ehv_a (jpi,jpj),                                                     & 
     371         &      ehur_a  (jpi,jpj)     , ehvr_a(jpi,jpj),                                                     & 
     372         &      ehu_b   (jpi,jpj)     , ehv_b (jpi,jpj),                                                     & 
     373         &      ehur_b  (jpi,jpj)     , ehvr_b(jpi,jpj),                                  STAT=ierr(5) )                           
     374#endif 
     375         ! 
     376      ALLOCATE( hu(jpi,jpj) , hur(jpi,jpj) , hu_0(jpi,jpj) , ht_0(jpi,jpj) ,     & 
     377         &      hv(jpi,jpj) , hvr(jpi,jpj) , hv_0(jpi,jpj) , ht  (jpi,jpj) , STAT=ierr(6)  ) 
    379378         ! 
    380379      ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) ,                                     & 
     
    387386         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     & 
    388387         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     & 
    389          &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(8) ) 
     388         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1(jpi,jpj) , STAT=ierr(8) ) 
    390389 
    391390      ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) ,                                      & 
    392391         &     tmask_i(jpi,jpj) , umask_i(jpi,jpj), vmask_i(jpi,jpj), fmask_i(jpi,jpj), & 
    393          &     bmask(jpi,jpj)  ,                                                       & 
     392         &     bmask  (jpi,jpj) ,                                                       & 
    394393         &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 
    395394 
    396395! (ISF) Allocation of basic array    
    397       ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj),     & 
    398          &     mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) ,           & 
    399          &     mikf(jpi,jpj), ssmask(jpi,jpj), STAT=ierr(10) ) 
     396      ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj),                   & 
     397         &      mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) ,           & 
     398         &      mikf(jpi,jpj), ssmask(jpi,jpj), STAT=ierr(10) ) 
    400399 
    401400      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     &  
     
    405404 
    406405#if defined key_noslip_accurate 
    407       ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(12) ) 
     406      ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(13) ) 
    408407#endif 
    409408      ! 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r5656 r5737  
    1414   !!                            use of parameters in par_CONFIG-Rxx.h90, not in namelist 
    1515   !!             -   ! 2004-05  (A. Koch-Larrouy) Add Gyre configuration  
    16    !!            4.0  ! 2011-02  (G. Madec) add cell surface (e1e2t) 
     16   !!            3.7  ! 2015-09  (G. Madec) add cell surface and their inverse 
     17   !!                                       add optional read of e1e2u & e1e2v 
    1718   !!---------------------------------------------------------------------- 
    1819 
     
    2324   USE dom_oce        ! ocean space and time domain 
    2425   USE phycst         ! physical constants 
     26   USE domwri         ! write 'meshmask.nc' & 'coordinate_e1e2u_v.nc' files 
     27   ! 
    2528   USE in_out_manager ! I/O manager 
    2629   USE lib_mpp        ! MPP library 
     
    3538 
    3639   !!---------------------------------------------------------------------- 
    37    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     40   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    3841   !! $Id$  
    3942   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    106109      REAL(wp) ::   zphi1, zsin_alpha, zim05, zjm05 
    107110      INTEGER  ::   isrow                ! index for ORCA1 starting row 
    108  
     111      INTEGER  ::   ie1e2u_v             ! fag for u- & v-surface read in coordinate file or not 
    109112      !!---------------------------------------------------------------------- 
    110113      ! 
     
    122125         WRITE(numout,*) '             meridional grid-spacing (meters)  ppe2_m   = ', ppe2_m   
    123126      ENDIF 
    124  
    125  
    126       SELECT CASE( jphgr_msh )   ! type of horizontal mesh 
    127  
    128       CASE ( 0 )                     !  curvilinear coordinate on the sphere read in coordinate.nc file 
    129  
     127      ! 
     128      ie1e2u_v = 0               !  set to unread e1e2u and e1e2v 
     129      ! 
     130      SELECT CASE( jphgr_msh )   !  type of horizontal mesh   
     131      ! 
     132      CASE ( 0 )                     !==  read in coordinate.nc file  ==! 
     133         ! 
    130134         IF(lwp) WRITE(numout,*) 
    131135         IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in "coordinate" file' 
    132  
    133          CALL hgr_read           ! Defaultl option  :   NetCDF file 
    134  
     136         ! 
     137         CALL hgr_read( ie1e2u_v ) 
     138         ! 
     139         IF( ie1e2u_v == 0 ) THEN      ! e1e2u and e1e2v have not been read: compute them 
     140            !                          ! e2u and e1v does not include a reduction in some strait: apply reduction 
     141            e1e2u (:,:) = e1u(:,:) * e2u(:,:)    
     142            e1e2v (:,:) = e1v(:,:) * e2v(:,:)  
     143 
     144         ! 
    135145         !                                                ! ===================== 
    136146         IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
     
    157167            ! 
    158168         ENDIF 
    159  
    160             !                                             ! ===================== 
     169         ! 
     170         !                                                ! ===================== 
    161171         IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration 
    162172            !                                             ! ===================== 
    163173            ! This dirty section will be suppressed by simplification process: all this will come back in input files 
    164174            ! Currently these hard-wired indices relate to configuration with 
    165             ! extend grid (jpjglo=332) 
    166             ! which had a grid-size of 362x292. 
     175            ! extend grid (jpjglo=332)  which had a grid-size of 362x292. 
    167176            !  
    168177            isrow = 332 - jpjglo 
     
    208217            IF(lwp) WRITE(numout,*) '             orca_r1: E Halmahera : e1v reduced to 50 km' 
    209218            ! 
    210             ! 
    211          ENDIF 
    212  
     219         ENDIF 
     220         ! 
    213221         !                                                ! ====================== 
    214222         IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration 
     
    251259            ! 
    252260         ENDIF 
    253  
    254  
     261          
     262            !                       ! create 'coordinate_e1e2u_v.nc' file  that contains 
     263            !                       ! reduced scale factor in some strait but full e1e2u and e1e2v surfaces          
     264            IF( ie1e2u_v == 0 )   CALL dom_wri_coordinate 
     265            ! 
     266            ! 
     267         ENDIF 
     268 
     269 
     270         ! 
    255271         ! N.B. :  General case, lat and long function of both i and j indices: 
    256272         !     e1t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdila( zti, ztj ) )**2   & 
     
    271287         !     e2f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdjla( zfi, zfj ) )**2   & 
    272288         !                                  + (                           fsdjph( zfi, zfj ) )**2  ) 
    273  
    274  
    275       CASE ( 1 )                     ! geographical mesh on the sphere with regular grid-spacing 
    276  
     289         ! 
     290         ! 
     291      CASE ( 1 )                     !==  geographical mesh on the sphere with regular (in degree) grid-spacing  ==! 
     292         ! 
    277293         IF(lwp) WRITE(numout,*) 
    278294         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere with regular grid-spacing' 
    279295         IF(lwp) WRITE(numout,*) '          given by ppe1_deg and ppe2_deg'  
    280  
     296         ! 
    281297         DO jj = 1, jpj 
    282298            DO ji = 1, jpi 
    283                zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    284                zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - 1 + njmpp - 1 ) 
    285                zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5 
    286                zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5 
     299               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - 1 + njmpp - 1 ) 
     300               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - 1 + njmpp - 1 ) 
     301               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - 1 + njmpp - 1 ) + 0.5 
     302               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - 1 + njmpp - 1 ) + 0.5 
    287303         ! Longitude 
    288304               glamt(ji,jj) = ppglam0 + ppe1_deg * zti 
     
    307323            END DO 
    308324         END DO 
    309  
    310  
    311       CASE ( 2:3 )                   ! f- or beta-plane with regular grid-spacing 
    312  
     325         ! 
     326      CASE ( 2:3 )                   !==  f- or beta-plane with regular grid-spacing  ==! 
     327         ! 
    313328         IF(lwp) WRITE(numout,*) 
    314329         IF(lwp) WRITE(numout,*) '          f- or beta-plane with regular grid-spacing' 
    315330         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m'  
    316  
     331         ! 
    317332         ! Position coordinates (in kilometers) 
    318333         !                          ========== 
    319334         glam0 = 0.e0 
    320335         gphi0 = - ppe2_m * 1.e-3 
    321           
     336         ! 
    322337#if defined key_agrif  
    323338         IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only 
     
    332347         DO jj = 1, jpj 
    333348            DO ji = 1, jpi 
    334                glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 )       ) 
    335                glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ) 
     349               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 )       ) 
     350               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) + 0.5 ) 
    336351               glamv(ji,jj) = glamt(ji,jj) 
    337352               glamf(ji,jj) = glamu(ji,jj) 
    338     
    339                gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 )       ) 
     353               ! 
     354               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 )       ) 
    340355               gphiu(ji,jj) = gphit(ji,jj) 
    341                gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 ) + 0.5 ) 
     356               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) + 0.5 ) 
    342357               gphif(ji,jj) = gphiv(ji,jj) 
    343358            END DO 
    344359         END DO 
    345  
     360         ! 
    346361         ! Horizontal scale factors (in meters) 
    347362         !                              ====== 
     
    350365         e1v(:,:) = ppe1_m      ;      e2v(:,:) = ppe2_m 
    351366         e1f(:,:) = ppe1_m      ;      e2f(:,:) = ppe2_m 
    352  
    353       CASE ( 4 )                     ! geographical mesh on the sphere, isotropic MERCATOR type 
    354  
     367         ! 
     368      CASE ( 4 )                     !==  geographical mesh on the sphere, isotropic MERCATOR type  ==! 
     369         ! 
    355370         IF(lwp) WRITE(numout,*) 
    356371         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere, MERCATOR type' 
    357372         IF(lwp) WRITE(numout,*) '          longitudinal/latitudinal spacing given by ppe1_deg' 
    358373         IF ( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' ) 
    359  
     374         ! 
    360375         !  Find index corresponding to the equator, given the grid spacing e1_deg 
    361376         !  and the (approximate) southern latitude ppgphi0. 
     
    365380         ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg ) 
    366381         IF(  ppgphi0 > 0 )  ijeq = -ijeq 
    367  
     382         ! 
    368383         IF(lwp) WRITE(numout,*) '          Index of the equator on the MERCATOR grid:', ijeq 
    369  
     384         ! 
    370385         DO jj = 1, jpj 
    371386            DO ji = 1, jpi 
    372                zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - ijeq + njmpp - 1 ) 
    373                zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - ijeq + njmpp - 1 ) 
    374                zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5 
    375                zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5 
     387               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - ijeq + njmpp - 1 ) 
     388               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - ijeq + njmpp - 1 ) 
     389               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - ijeq + njmpp - 1 ) + 0.5 
     390               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - ijeq + njmpp - 1 ) + 0.5 
    376391         ! Longitude 
    377392               glamt(ji,jj) = ppglam0 + ppe1_deg * zti 
     
    396411            END DO 
    397412         END DO 
    398  
    399       CASE ( 5 )                   ! beta-plane with regular grid-spacing and rotated domain (GYRE configuration) 
    400  
     413         ! 
     414      CASE ( 5 )                   !==  beta-plane with regular grid-spacing and rotated domain ==! (GYRE configuration) 
     415         ! 
    401416         IF(lwp) WRITE(numout,*) 
    402417         IF(lwp) WRITE(numout,*) '          beta-plane with regular grid-spacing and rotated domain (GYRE configuration)' 
    403418         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m' 
    404  
     419         ! 
    405420         ! Position coordinates (in kilometers) 
    406421         !                          ========== 
    407  
     422         ! 
    408423         ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN 
    409          zlam1 = -85 
    410          zphi1 = 29 
     424         zlam1 = -85._wp 
     425         zphi1 =  29._wp 
    411426         ! resolution in meters 
    412          ze1 = 106000. / FLOAT(jp_cfg)             
     427         ze1 = 106000. / REAL( jp_cfg , wp )             
    413428         ! benchmark: forced the resolution to be about 100 km 
    414429         IF( nbench /= 0 )   ze1 = 106000.e0      
    415          zsin_alpha = - SQRT( 2. ) / 2. 
    416          zcos_alpha =   SQRT( 2. ) / 2. 
     430         zsin_alpha = - SQRT( 2._wp ) * 0.5_wp 
     431         zcos_alpha =   SQRT( 2._wp ) * 0.5_wp 
    417432         ze1deg = ze1 / (ra * rad) 
    418          IF( nbench /= 0 )   ze1deg = ze1deg / FLOAT(jp_cfg)        ! benchmark: keep the lat/+lon 
    419          !                                                          ! at the right jp_cfg resolution 
    420          glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpjglo-2 ) 
    421          gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpjglo-2 ) 
    422  
     433         IF( nbench /= 0 )   ze1deg = ze1deg / REAL( jp_cfg , wp )   ! benchmark: keep the lat/+lon 
     434         !                                                           ! at the right jp_cfg resolution 
     435         glam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp ) 
     436         gphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp ) 
     437         ! 
    423438         IF( nprint==1 .AND. lwp )   THEN 
    424439            WRITE(numout,*) '          ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha 
    425440            WRITE(numout,*) '          ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0 
    426441         ENDIF 
    427  
     442         ! 
    428443         DO jj = 1, jpj 
    429            DO ji = 1, jpi 
    430              zim1 = FLOAT( ji + nimpp - 1 ) - 1.   ;   zim05 = FLOAT( ji + nimpp - 1 ) - 1.5 
    431              zjm1 = FLOAT( jj + njmpp - 1 ) - 1.   ;   zjm05 = FLOAT( jj + njmpp - 1 ) - 1.5 
    432  
    433              glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
    434              gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
    435  
    436              glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
    437              gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
    438  
    439              glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
    440              gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
    441  
    442              glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
    443              gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
    444            END DO 
    445           END DO 
    446  
     444            DO ji = 1, jpi 
     445               zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5 
     446               zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5 
     447               ! 
     448               glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
     449               gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
     450               ! 
     451               glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
     452               gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
     453               ! 
     454               glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
     455               gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
     456               ! 
     457               glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
     458               gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
     459            END DO 
     460         END DO 
     461         ! 
    447462         ! Horizontal scale factors (in meters) 
    448463         !                              ====== 
     
    451466         e1v(:,:) =  ze1     ;      e2v(:,:) = ze1 
    452467         e1f(:,:) =  ze1     ;      e2f(:,:) = ze1 
    453  
     468         ! 
    454469      CASE DEFAULT 
    455470         WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh 
    456471         CALL ctl_stop( ctmp1 ) 
    457  
     472         ! 
    458473      END SELECT 
    459474       
    460       ! T-cell surface 
    461       ! -------------- 
    462       e1e2t(:,:) = e1t(:,:) * e2t(:,:) 
    463      
    464       ! Useful shortcuts (JC: note the duplicated e2e2t array ! Need some cleaning) 
    465       ! --------------------------------------------------------------------------- 
    466       e12t    (:,:) = e1t(:,:) * e2t(:,:) 
    467       e12u    (:,:) = e1u(:,:) * e2u(:,:) 
    468       e12v    (:,:) = e1v(:,:) * e2v(:,:) 
    469       e12f    (:,:) = e1f(:,:) * e2f(:,:) 
    470       r1_e12t (:,:) = 1._wp    / e12t(:,:) 
    471       r1_e12u (:,:) = 1._wp    / e12u(:,:) 
    472       r1_e12v (:,:) = 1._wp    / e12v(:,:) 
    473       r1_e12f (:,:) = 1._wp    / e12f(:,:) 
    474       re2u_e1u(:,:) = e2u(:,:) / e1u(:,:) 
    475       re1v_e2v(:,:) = e1v(:,:) / e2v(:,:) 
    476       r1_e1t  (:,:) = 1._wp    / e1t(:,:) 
    477       r1_e1u  (:,:) = 1._wp    / e1u(:,:) 
    478       r1_e1v  (:,:) = 1._wp    / e1v(:,:) 
    479       r1_e1f  (:,:) = 1._wp    / e1f(:,:) 
    480       r1_e2t  (:,:) = 1._wp    / e2t(:,:) 
    481       r1_e2u  (:,:) = 1._wp    / e2u(:,:) 
    482       r1_e2v  (:,:) = 1._wp    / e2v(:,:) 
    483       r1_e2f  (:,:) = 1._wp    / e2f(:,:) 
    484  
    485       ! Control printing : Grid informations (if not restart) 
    486       ! ---------------- 
    487  
    488       IF( lwp .AND. .NOT.ln_rstart ) THEN 
     475      ! associated horizontal metrics 
     476      ! ----------------------------- 
     477      ! 
     478      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:) 
     479      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:) 
     480      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:) 
     481      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:) 
     482      ! 
     483      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 
     484      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:) 
     485      IF( jphgr_msh /= 0 ) THEN               ! e1e2u and e1e2v have not been set: compute them 
     486         e1e2u (:,:) = e1u(:,:) * e2u(:,:)    
     487         e1e2v (:,:) = e1v(:,:) * e2v(:,:)  
     488      ENDIF 
     489      r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in both cases 
     490      r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 
     491      !    
     492      e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 
     493      e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 
     494 
     495      IF( lwp .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart) 
    489496         WRITE(numout,*) 
    490497         WRITE(numout,*) '          longitude and e1 scale factors' 
     
    4965039300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    & 
    497504            f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 ) 
    498           
     505            ! 
    499506         WRITE(numout,*) 
    500507         WRITE(numout,*) '          latitude and e2 scale factors' 
     
    506513      ENDIF 
    507514 
    508        
    509       IF( nprint == 1 .AND. lwp ) THEN 
    510          WRITE(numout,*) '          e1u e2u ' 
    511          CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    512          CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    513          WRITE(numout,*) '          e1v e2v  ' 
    514          CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    515          CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    516          WRITE(numout,*) '          e1f e2f  ' 
    517          CALL prihre( e1f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    518          CALL prihre( e2f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    519       ENDIF 
    520  
    521515 
    522516      ! ================= ! 
     
    525519 
    526520      SELECT CASE( jphgr_msh )   ! type of horizontal mesh 
    527  
     521      ! 
    528522      CASE ( 0, 1, 4 )               ! mesh on the sphere 
    529  
     523         ! 
    530524         ff(:,:) = 2. * omega * SIN( rad * gphif(:,:) )  
    531  
     525         ! 
    532526      CASE ( 2 )                     ! f-plane at ppgphi0  
    533  
     527         ! 
    534528         ff(:,:) = 2. * omega * SIN( rad * ppgphi0 ) 
    535  
     529         ! 
    536530         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1) 
    537  
     531         ! 
    538532      CASE ( 3 )                     ! beta-plane 
    539  
     533         ! 
    540534         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                       ! beta at latitude ppgphi0 
    541          zphi0   = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points 
    542           
     535         zphi0   = ppgphi0 - REAL( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points 
     536         ! 
    543537#if defined key_agrif 
    544538         IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only 
    545539            IF( .NOT. Agrif_Root() ) THEN 
    546               zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m)   &  
    547                     &           / (ra * rad) 
     540              zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 
    548541            ENDIF 
    549542         ENDIF 
    550543#endif          
    551544         zf0     = 2. * omega * SIN( rad * zphi0 )                              ! compute f0 1st point south 
    552  
     545         ! 
    553546         ff(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south) 
    554           
     547         ! 
    555548         IF(lwp) THEN 
    556549            WRITE(numout,*)  
     
    565558            IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff 
    566559         END IF 
    567  
     560         ! 
    568561      CASE ( 5 )                     ! beta-plane and rotated domain (gyre configuration) 
    569  
     562         ! 
    570563         zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0 
    571564         zphi0 = 15.e0                                                      ! latitude of the first row F-points 
    572565         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south 
    573  
     566         ! 
    574567         ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south) 
    575  
     568         ! 
    576569         IF(lwp) THEN 
    577570            WRITE(numout,*)  
     
    579572            WRITE(numout,*) '          Coriolis parameter varies in this processor from ', ff(nldi,nldj),' to ', ff(nldi,nlej) 
    580573         ENDIF 
    581  
     574         ! 
    582575         IF( lk_mpp ) THEN  
    583576            zminff=ff(nldi,nldj) 
     
    587580            IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff 
    588581         END IF 
    589  
     582         ! 
    590583      END SELECT 
    591584 
     
    596589 
    597590      IF( nperio == 2 ) THEN 
    598          znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / FLOAT( jpi ) 
     591         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi ) 
    599592         IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' ) 
    600593      ENDIF 
     
    605598 
    606599 
    607    SUBROUTINE hgr_read 
     600   SUBROUTINE hgr_read( ke1e2u_v ) 
    608601      !!--------------------------------------------------------------------- 
    609602      !!              ***  ROUTINE hgr_read  *** 
    610603      !! 
    611       !! ** Purpose :   Read a coordinate file in NetCDF format  
    612       !! 
    613       !! ** Method  :   The mesh file has been defined trough a analytical  
    614       !!      or semi-analytical method. It is read in a NetCDF file.  
    615       !!      
     604      !! ** Purpose :   Read a coordinate file in NetCDF format using IOM 
     605      !! 
    616606      !!---------------------------------------------------------------------- 
    617607      USE iom 
    618  
     608      !! 
     609      INTEGER, INTENT( inout ) ::   ke1e2u_v   ! fag: e1e2u & e1e2v read in coordinate file (=1) or not (=0) 
     610      ! 
    619611      INTEGER ::   inum   ! temporary logical unit 
    620612      !!---------------------------------------------------------------------- 
    621  
     613      ! 
    622614      IF(lwp) THEN 
    623615         WRITE(numout,*) 
     
    625617         WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk 
    626618      ENDIF 
    627        
     619      ! 
    628620      CALL iom_open( 'coordinates', inum ) 
    629        
     621      ! 
    630622      CALL iom_get( inum, jpdom_data, 'glamt', glamt, lrowattr=ln_use_jattr ) 
    631623      CALL iom_get( inum, jpdom_data, 'glamu', glamu, lrowattr=ln_use_jattr ) 
    632624      CALL iom_get( inum, jpdom_data, 'glamv', glamv, lrowattr=ln_use_jattr ) 
    633625      CALL iom_get( inum, jpdom_data, 'glamf', glamf, lrowattr=ln_use_jattr ) 
    634        
     626      ! 
    635627      CALL iom_get( inum, jpdom_data, 'gphit', gphit, lrowattr=ln_use_jattr ) 
    636628      CALL iom_get( inum, jpdom_data, 'gphiu', gphiu, lrowattr=ln_use_jattr ) 
    637629      CALL iom_get( inum, jpdom_data, 'gphiv', gphiv, lrowattr=ln_use_jattr ) 
    638630      CALL iom_get( inum, jpdom_data, 'gphif', gphif, lrowattr=ln_use_jattr ) 
    639        
    640       CALL iom_get( inum, jpdom_data, 'e1t', e1t, lrowattr=ln_use_jattr ) 
    641       CALL iom_get( inum, jpdom_data, 'e1u', e1u, lrowattr=ln_use_jattr ) 
    642       CALL iom_get( inum, jpdom_data, 'e1v', e1v, lrowattr=ln_use_jattr ) 
    643       CALL iom_get( inum, jpdom_data, 'e1f', e1f, lrowattr=ln_use_jattr ) 
    644        
    645       CALL iom_get( inum, jpdom_data, 'e2t', e2t, lrowattr=ln_use_jattr ) 
    646       CALL iom_get( inum, jpdom_data, 'e2u', e2u, lrowattr=ln_use_jattr ) 
    647       CALL iom_get( inum, jpdom_data, 'e2v', e2v, lrowattr=ln_use_jattr ) 
    648       CALL iom_get( inum, jpdom_data, 'e2f', e2f, lrowattr=ln_use_jattr ) 
    649        
     631      ! 
     632      CALL iom_get( inum, jpdom_data, 'e1t'  , e1t  , lrowattr=ln_use_jattr ) 
     633      CALL iom_get( inum, jpdom_data, 'e1u'  , e1u  , lrowattr=ln_use_jattr ) 
     634      CALL iom_get( inum, jpdom_data, 'e1v'  , e1v  , lrowattr=ln_use_jattr ) 
     635      CALL iom_get( inum, jpdom_data, 'e1f'  , e1f  , lrowattr=ln_use_jattr ) 
     636      ! 
     637      CALL iom_get( inum, jpdom_data, 'e2t'  , e2t  , lrowattr=ln_use_jattr ) 
     638      CALL iom_get( inum, jpdom_data, 'e2u'  , e2u  , lrowattr=ln_use_jattr ) 
     639      CALL iom_get( inum, jpdom_data, 'e2v'  , e2v  , lrowattr=ln_use_jattr ) 
     640      CALL iom_get( inum, jpdom_data, 'e2f'  , e2f  , lrowattr=ln_use_jattr ) 
     641      ! 
     642      IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN 
     643         IF(lwp) WRITE(numout,*) 'hgr_read : e1e2u & e1e2v read in coordinates file' 
     644         CALL iom_get( inum, jpdom_data, 'e1e2u'  , e1e2u  , lrowattr=ln_use_jattr ) 
     645         CALL iom_get( inum, jpdom_data, 'e1e2v'  , e1e2v  , lrowattr=ln_use_jattr ) 
     646         ke1e2u_v = 1 
     647      ELSE 
     648         ke1e2u_v = 0 
     649      ENDIF 
     650      ! 
    650651      CALL iom_close( inum ) 
    651652       
     653!!gm   THIS is TO BE REMOVED !!!!!!! 
     654 
    652655! need to be define for the extended grid south of -80S 
    653656! some point are undefined but you need to have e1 and e2 .NE. 0 
     
    676679         e2f=1.0e2 
    677680      END WHERE 
     681!!gm end 
    678682        
    679683    END SUBROUTINE hgr_read 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r5506 r5737  
    1010   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    1111   !!---------------------------------------------------------------------- 
    12    !!   'key_vvl'                              variable volume 
    13    !!---------------------------------------------------------------------- 
     12 
    1413   !!---------------------------------------------------------------------- 
    1514   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
     
    1918   !!   dom_vvl_rst      : read/write restart file 
    2019   !!   dom_vvl_ctl      : Check the vvl options 
    21    !!   dom_vvl_orca_fix : Recompute some area-weighted interpolations of vertical scale factors  
    22    !!                    : to account for manual changes to e[1,2][u,v] in some Straits  
    2320   !!---------------------------------------------------------------------- 
    24    !! * Modules used 
    2521   USE oce             ! ocean dynamics and tracers 
    2622   USE dom_oce         ! ocean space and time domain 
     
    3733   PRIVATE 
    3834 
    39    !! * Routine accessibility 
    4035   PUBLIC  dom_vvl_init       ! called by domain.F90 
    4136   PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
    4237   PUBLIC  dom_vvl_sf_swp     ! called by step.F90 
    4338   PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
    44    PRIVATE dom_vvl_orca_fix   ! called by dom_vvl_interpol 
    45  
    46    !!* Namelist nam_vvl 
    47    LOGICAL , PUBLIC                                      :: ln_vvl_zstar = .FALSE.              ! zstar  vertical coordinate 
    48    LOGICAL , PUBLIC                                      :: ln_vvl_ztilde = .FALSE.             ! ztilde vertical coordinate 
    49    LOGICAL , PUBLIC                                      :: ln_vvl_layer = .FALSE.              ! level  vertical coordinate 
    50    LOGICAL , PUBLIC                                      :: ln_vvl_ztilde_as_zstar = .FALSE.    ! ztilde vertical coordinate 
    51    LOGICAL , PUBLIC                                      :: ln_vvl_zstar_at_eqtor = .FALSE.     ! ztilde vertical coordinate 
    52    LOGICAL , PUBLIC                                      :: ln_vvl_kepe = .FALSE.               ! kinetic/potential energy transfer 
    53    !                                                                                            ! conservation: not used yet 
    54    REAL(wp)                                              :: rn_ahe3                   ! thickness diffusion coefficient 
    55    REAL(wp)                                              :: rn_rst_e3t                ! ztilde to zstar restoration timescale [days] 
    56    REAL(wp)                                              :: rn_lf_cutoff              ! cutoff frequency for low-pass filter  [days] 
    57    REAL(wp)                                              :: rn_zdef_max               ! maximum fractional e3t deformation 
    58    LOGICAL , PUBLIC                                      :: ln_vvl_dbg = .FALSE.      ! debug control prints 
    59  
    60    !! * Module variables 
    61    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                       ! thickness diffusion transport 
    62    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf                            ! low frequency part of hz divergence 
    63    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n           ! baroclinic scale factors 
    64    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a          ! baroclinic scale factors 
    65    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_e3t                        ! retoring period for scale factors 
    66    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                        ! retoring period for low freq. divergence 
     39 
     40   !                                                      !!* Namelist nam_vvl 
     41   LOGICAL , PUBLIC :: ln_vvl_zstar           = .FALSE.    ! zstar  vertical coordinate 
     42   LOGICAL , PUBLIC :: ln_vvl_ztilde          = .FALSE.    ! ztilde vertical coordinate 
     43   LOGICAL , PUBLIC :: ln_vvl_layer           = .FALSE.    ! level  vertical coordinate 
     44   LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar = .FALSE.    ! ztilde vertical coordinate 
     45   LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor  = .FALSE.    ! ztilde vertical coordinate 
     46   LOGICAL , PUBLIC :: ln_vvl_kepe            = .FALSE.    ! kinetic/potential energy transfer 
     47   !                                                       ! conservation: not used yet 
     48   REAL(wp)         :: rn_ahe3                             ! thickness diffusion coefficient 
     49   REAL(wp)         :: rn_rst_e3t                          ! ztilde to zstar restoration timescale [days] 
     50   REAL(wp)         :: rn_lf_cutoff                        ! cutoff frequency for low-pass filter  [days] 
     51   REAL(wp)         :: rn_zdef_max                         ! maximum fractional e3t deformation 
     52   LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE.                ! debug control prints 
     53 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                ! thickness diffusion transport 
     55   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf                     ! low frequency part of hz divergence 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n    ! baroclinic scale factors 
     57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a   ! baroclinic scale factors 
     58   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_e3t                 ! retoring period for scale factors 
     59   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence 
    6760 
    6861   !! * Substitutions 
     
    372365            DO jj = 1, jpjm1 
    373366               DO ji = 1, fs_jpim1   ! vector opt. 
    374                   un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * re2u_e1u(ji,jj) & 
    375                                   & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
    376                   vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * re1v_e2v(ji,jj) &  
    377                                   & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
     367                  un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)          & 
     368                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
     369                  vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)          &  
     370                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
    378371                  zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 
    379372                  zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
     
    394387                  tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    & 
    395388                     &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    & 
    396                      &                                            ) * r1_e12t(ji,jj) 
     389                     &                                            ) * r1_e1e2t(ji,jj) 
    397390               END DO 
    398391            END DO 
     
    695688      !!                - vertical interpolation: simple averaging 
    696689      !!---------------------------------------------------------------------- 
    697       !! * Arguments 
    698690      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in    ) ::  pe3_in     ! input e3 to be interpolated 
    699691      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::  pe3_out    ! output interpolated e3 
    700692      CHARACTER(LEN=*), INTENT( in )                    ::  pout       ! grid point of out scale factors 
    701693      !                                                                !   =  'U', 'V', 'W, 'F', 'UW' or 'VW' 
    702       !! * Local declarations 
     694      ! 
    703695      INTEGER ::   ji, jj, jk                                          ! dummy loop indices 
    704696      LOGICAL ::   l_is_orca                                           ! local logical 
     
    717709            DO jj = 1, jpjm1 
    718710               DO ji = 1, fs_jpim1   ! vector opt. 
    719                   pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e12u(ji,jj)                                   & 
    720                      &                       * (   e12t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     & 
    721                      &                           + e12t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 
     711                  pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e1e2u(ji,jj)                                   & 
     712                     &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     & 
     713                     &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 
    722714               END DO 
    723715            END DO 
    724716         END DO 
    725717         ! 
    726          IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 
    727718         ! boundary conditions 
    728719         CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp ) 
     
    735726            DO jj = 1, jpjm1 
    736727               DO ji = 1, fs_jpim1   ! vector opt. 
    737                   pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e12v(ji,jj)                                   & 
    738                      &                       * (   e12t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     & 
    739                      &                           + e12t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 
     728                  pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e1e2v(ji,jj)                                   & 
     729                     &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     & 
     730                     &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 
    740731               END DO 
    741732            END DO 
    742733         END DO 
    743734         ! 
    744          IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 
    745735         ! boundary conditions 
    746736         CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp ) 
     
    753743            DO jj = 1, jpjm1 
    754744               DO ji = 1, fs_jpim1   ! vector opt. 
    755                   pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e12f(ji,jj)               & 
    756                      &                       * (   e12u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     & 
    757                      &                           + e12u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 
     745                  pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e1e2f(ji,jj)               & 
     746                     &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     & 
     747                     &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 
    758748               END DO 
    759749            END DO 
    760750         END DO 
    761751         ! 
    762          IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 
    763752         ! boundary conditions 
    764753         CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp ) 
     
    10211010   END SUBROUTINE dom_vvl_ctl 
    10221011 
    1023    SUBROUTINE dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 
    1024       !!--------------------------------------------------------------------- 
    1025       !!                   ***  ROUTINE dom_vvl_orca_fix  *** 
    1026       !!                      
    1027       !! ** Purpose :   Correct surface weighted, horizontally interpolated,  
    1028       !!                scale factors at locations that have been individually 
    1029       !!                modified in domhgr. Such modifications break the 
    1030       !!                relationship between e12t and e1u*e2u etc. 
    1031       !!                Recompute some scale factors ignoring the modified metric. 
    1032       !!---------------------------------------------------------------------- 
    1033       !! * Arguments 
    1034       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in    ) ::  pe3_in     ! input e3 to be interpolated 
    1035       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::  pe3_out    ! output interpolated e3 
    1036       CHARACTER(LEN=*), INTENT( in )                    ::  pout       ! grid point of out scale factors 
    1037       !                                                                !   =  'U', 'V', 'W, 'F', 'UW' or 'VW' 
    1038       !! * Local declarations 
    1039       INTEGER ::   ji, jj, jk                                          ! dummy loop indices 
    1040       INTEGER ::   ij0, ij1, ii0, ii1                                  ! dummy loop indices 
    1041       INTEGER ::   isrow                                               ! index for ORCA1 starting row 
    1042       !! acc 
    1043       !! Hmm with the time splitting these "fixes" seem to do more harm than good. Temporarily disabled for 
    1044       !! the ORCA2 tests (by changing jp_cfg test from 2 to 3) pending further investigations 
    1045       !!  
    1046       !                                                ! ===================== 
    1047       IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN    ! ORCA R2 configuration 
    1048          !                                             ! ===================== 
    1049       !! acc 
    1050          IF( nn_cla == 0 ) THEN 
    1051             ! 
    1052             ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u was modified) 
    1053             ij0 = 102   ;   ij1 = 102 
    1054             DO jk = 1, jpkm1 
    1055                DO jj = mj0(ij0), mj1(ij1) 
    1056                   DO ji = mi0(ii0), mi1(ii1) 
    1057                      SELECT CASE ( pout ) 
    1058                      CASE( 'U' ) 
    1059                         pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1060                        &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1061                        &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1062                        &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1063                      CASE( 'F' ) 
    1064                         pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1065                        &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1066                        &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1067                        &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1068                      END SELECT 
    1069                   END DO 
    1070                END DO 
    1071             END DO 
    1072             ! 
    1073             ii0 = 160   ;   ii1 = 160        ! Bab el Mandeb (e2u and e1v were modified) 
    1074             ij0 =  88   ;   ij1 =  88 
    1075             DO jk = 1, jpkm1 
    1076                DO jj = mj0(ij0), mj1(ij1) 
    1077                   DO ji = mi0(ii0), mi1(ii1) 
    1078                      SELECT CASE ( pout ) 
    1079                      CASE( 'U' ) 
    1080                         pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1081                        &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1082                        &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1083                        &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1084                      CASE( 'V' ) 
    1085                         pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1086                        &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1087                        &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1088                        &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1089                      CASE( 'F' ) 
    1090                         pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1091                        &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1092                        &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1093                        &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1094                      END SELECT 
    1095                   END DO 
    1096                END DO 
    1097             END DO 
    1098          ENDIF 
    1099  
    1100          ii0 = 145   ;   ii1 = 146        ! Danish Straits (e2u was modified) 
    1101          ij0 = 116   ;   ij1 = 116 
    1102          DO jk = 1, jpkm1 
    1103             DO jj = mj0(ij0), mj1(ij1) 
    1104                DO ji = mi0(ii0), mi1(ii1) 
    1105                   SELECT CASE ( pout ) 
    1106                   CASE( 'U' ) 
    1107                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1108                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1109                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1110                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1111                   CASE( 'F' ) 
    1112                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1113                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1114                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1115                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1116                   END SELECT 
    1117                END DO 
    1118             END DO 
    1119          END DO 
    1120       ENDIF 
    1121       ! 
    1122          !                                             ! ===================== 
    1123       IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration 
    1124          !                                             ! ===================== 
    1125          ! This dirty section will be suppressed by simplification process: 
    1126          ! all this will come back in input files 
    1127          ! Currently these hard-wired indices relate to configuration with 
    1128          ! extend grid (jpjglo=332) 
    1129          ! which had a grid-size of 362x292. 
    1130          isrow = 332 - jpjglo 
    1131          ! 
    1132          ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait (e2u was modified) 
    1133          ij0 = 241 - isrow   ;   ij1 = 241 - isrow 
    1134          DO jk = 1, jpkm1 
    1135             DO jj = mj0(ij0), mj1(ij1) 
    1136                DO ji = mi0(ii0), mi1(ii1) 
    1137                   SELECT CASE ( pout ) 
    1138                   CASE( 'U' ) 
    1139                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1140                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1141                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1142                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1143                   CASE( 'F' ) 
    1144                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1145                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1146                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1147                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1148                   END SELECT 
    1149                END DO 
    1150             END DO 
    1151          END DO 
    1152          ! 
    1153          ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u was modified) 
    1154          ij0 = 248 - isrow   ;   ij1 = 248 - isrow 
    1155          DO jk = 1, jpkm1 
    1156             DO jj = mj0(ij0), mj1(ij1) 
    1157                DO ji = mi0(ii0), mi1(ii1) 
    1158                   SELECT CASE ( pout ) 
    1159                   CASE( 'U' ) 
    1160                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &   
    1161                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1162                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1163                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1164                   CASE( 'F' ) 
    1165                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &   
    1166                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1167                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1168                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1169                   END SELECT 
    1170                END DO 
    1171             END DO 
    1172          END DO 
    1173          ! 
    1174          ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v was modified) 
    1175          ij0 = 164 - isrow   ;   ij1 = 165 - isrow 
    1176          DO jk = 1, jpkm1 
    1177             DO jj = mj0(ij0), mj1(ij1) 
    1178                DO ji = mi0(ii0), mi1(ii1) 
    1179                   SELECT CASE ( pout ) 
    1180                   CASE( 'V' ) 
    1181                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1182                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1183                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1184                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1185                   END SELECT 
    1186                END DO 
    1187             END DO 
    1188          END DO 
    1189          ! 
    1190          ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on] 
    1191          ij0 = 164 - isrow   ;   ij1 = 165 - isrow 
    1192          DO jk = 1, jpkm1 
    1193             DO jj = mj0(ij0), mj1(ij1) 
    1194                DO ji = mi0(ii0), mi1(ii1) 
    1195                   SELECT CASE ( pout ) 
    1196                   CASE( 'V' ) 
    1197                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1198                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1199                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1200                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1201                   END SELECT 
    1202                END DO 
    1203             END DO 
    1204          END DO 
    1205          ! 
    1206          ii0 =  53          ;   ii1 =  53        ! Ombai Strait (e1v was modified) 
    1207          ij0 = 164 - isrow  ;   ij1 = 165  - isrow   
    1208          DO jk = 1, jpkm1 
    1209             DO jj = mj0(ij0), mj1(ij1) 
    1210                DO ji = mi0(ii0), mi1(ii1) 
    1211                   SELECT CASE ( pout ) 
    1212                   CASE( 'V' ) 
    1213                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1214                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1215                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1216                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1217                   END SELECT 
    1218                END DO 
    1219             END DO 
    1220          END DO 
    1221          ! 
    1222          ii0 =  56            ;   ii1 =  56        ! Timor Passage (e1v was modified) 
    1223          ij0 = 164 - isrow    ;   ij1 = 165  - isrow   
    1224          DO jk = 1, jpkm1 
    1225             DO jj = mj0(ij0), mj1(ij1) 
    1226                DO ji = mi0(ii0), mi1(ii1) 
    1227                   SELECT CASE ( pout ) 
    1228                   CASE( 'V' ) 
    1229                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1230                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1231                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1232                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1233                   END SELECT 
    1234                END DO 
    1235             END DO 
    1236          END DO 
    1237          ! 
    1238          ii0 =  55            ;   ii1 =  55        ! West Halmahera Strait (e1v was modified) 
    1239          ij0 = 181 - isrow    ;   ij1 = 182 - isrow   
    1240          DO jk = 1, jpkm1 
    1241             DO jj = mj0(ij0), mj1(ij1) 
    1242                DO ji = mi0(ii0), mi1(ii1) 
    1243                   SELECT CASE ( pout ) 
    1244                   CASE( 'V' ) 
    1245                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1246                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1247                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1248                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1249                   END SELECT 
    1250                END DO 
    1251             END DO 
    1252          END DO 
    1253          ! 
    1254          ii0 =  58            ;   ii1 =  58        ! East Halmahera Strait (e1v was modified) 
    1255          ij0 = 181 - isrow    ;   ij1 = 182 - isrow   
    1256          DO jk = 1, jpkm1 
    1257             DO jj = mj0(ij0), mj1(ij1) 
    1258                DO ji = mi0(ii0), mi1(ii1) 
    1259                   SELECT CASE ( pout ) 
    1260                   CASE( 'V' ) 
    1261                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1262                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1263                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1264                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1265                   END SELECT 
    1266                END DO 
    1267             END DO 
    1268          END DO 
    1269       ENDIF 
    1270          !                                             ! ===================== 
    1271       IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration 
    1272          !                                             ! ===================== 
    1273          ! 
    1274          ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u was modified) 
    1275          ij0 = 327   ;   ij1 = 327 
    1276          DO jk = 1, jpkm1 
    1277             DO jj = mj0(ij0), mj1(ij1) 
    1278                DO ji = mi0(ii0), mi1(ii1) 
    1279                   SELECT CASE ( pout ) 
    1280                   CASE( 'U' ) 
    1281                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1282                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1283                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1284                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1285                   CASE( 'F' ) 
    1286                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1287                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1288                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1289                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1290                   END SELECT 
    1291                END DO 
    1292             END DO 
    1293          END DO 
    1294          ! 
    1295          ii0 = 627   ;   ii1 = 628        ! Bosphorus Strait (e2u was modified) 
    1296          ij0 = 343   ;   ij1 = 343 
    1297          DO jk = 1, jpkm1 
    1298             DO jj = mj0(ij0), mj1(ij1) 
    1299                DO ji = mi0(ii0), mi1(ii1) 
    1300                   SELECT CASE ( pout ) 
    1301                   CASE( 'U' ) 
    1302                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &   
    1303                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1304                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1305                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1306                   CASE( 'F' ) 
    1307                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &   
    1308                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1309                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1310                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1311                   END SELECT 
    1312                END DO 
    1313             END DO 
    1314          END DO 
    1315          ! 
    1316          ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u was modified) 
    1317          ij0 = 232   ;   ij1 = 232 
    1318          DO jk = 1, jpkm1 
    1319             DO jj = mj0(ij0), mj1(ij1) 
    1320                DO ji = mi0(ii0), mi1(ii1) 
    1321                   SELECT CASE ( pout ) 
    1322                   CASE( 'U' ) 
    1323                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1324                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1325                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1326                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1327                   CASE( 'F' ) 
    1328                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1329                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1330                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1331                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1332                   END SELECT 
    1333                END DO 
    1334             END DO 
    1335          END DO 
    1336          ! 
    1337          ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u was modified) 
    1338          ij0 = 232   ;   ij1 = 232 
    1339          DO jk = 1, jpkm1 
    1340             DO jj = mj0(ij0), mj1(ij1) 
    1341                DO ji = mi0(ii0), mi1(ii1) 
    1342                   SELECT CASE ( pout ) 
    1343                   CASE( 'U' ) 
    1344                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1345                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1346                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1347                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1348                   CASE( 'F' ) 
    1349                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1350                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1351                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1352                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1353                   END SELECT 
    1354                END DO 
    1355             END DO 
    1356          END DO 
    1357          ! 
    1358          ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u was modified) 
    1359          ij0 = 270   ;   ij1 = 270 
    1360          DO jk = 1, jpkm1 
    1361             DO jj = mj0(ij0), mj1(ij1) 
    1362                DO ji = mi0(ii0), mi1(ii1) 
    1363                   SELECT CASE ( pout ) 
    1364                   CASE( 'U' ) 
    1365                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1366                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1367                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1368                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1369                   CASE( 'F' ) 
    1370                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1371                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1372                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1373                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1374                   END SELECT 
    1375                END DO 
    1376             END DO 
    1377          END DO 
    1378          ! 
    1379          ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v was modified) 
    1380          ij0 = 232   ;   ij1 = 233 
    1381          DO jk = 1, jpkm1 
    1382             DO jj = mj0(ij0), mj1(ij1) 
    1383                DO ji = mi0(ii0), mi1(ii1) 
    1384                   SELECT CASE ( pout ) 
    1385                   CASE( 'V' ) 
    1386                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1387                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1388                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1389                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1390                   END SELECT 
    1391                END DO 
    1392             END DO 
    1393          END DO 
    1394          ! 
    1395          ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v was modified) 
    1396          ij0 = 276   ;   ij1 = 276 
    1397          DO jk = 1, jpkm1 
    1398             DO jj = mj0(ij0), mj1(ij1) 
    1399                DO ji = mi0(ii0), mi1(ii1) 
    1400                   SELECT CASE ( pout ) 
    1401                   CASE( 'V' ) 
    1402                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1403                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1404                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1405                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1406                   END SELECT 
    1407                END DO 
    1408             END DO 
    1409          END DO 
    1410       ENDIF 
    1411    END SUBROUTINE dom_vvl_orca_fix 
    1412  
    14131012   !!====================================================================== 
    14141013END MODULE domvvl 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r5603 r5737  
    2626   PRIVATE 
    2727 
    28    PUBLIC dom_wri        ! routine called by inidom.F90 
    29  
     28   PUBLIC   dom_wri              ! routine called by inidom.F90 
     29   PUBLIC   dom_wri_coordinate   ! routine called by domhgr.F90 
    3030   !! * Substitutions 
    3131#  include "vectopt_loop_substitute.h90" 
     
    3636   !!---------------------------------------------------------------------- 
    3737CONTAINS 
     38 
     39 
     40 
     41   SUBROUTINE dom_wri_coordinate 
     42      !!---------------------------------------------------------------------- 
     43      !!                  ***  ROUTINE dom_wri_coordinate  *** 
     44      !!                    
     45      !! ** Purpose :   Create the NetCDF file which contains all the 
     46      !!              standard coordinate information plus the surface, 
     47      !!              e1e2u and e1e2v. By doing so, those surface will 
     48      !!              not be changed by the reduction of e1u or e2v scale  
     49      !!              factors in some straits.  
     50      !!                 NB: call just after the read of standard coordinate 
     51      !!              and the reduction of scale factors in some straits 
     52      !! 
     53      !! ** output file :   coordinate_e1e2u_v.nc 
     54      !!---------------------------------------------------------------------- 
     55      INTEGER           ::   inum0    ! temprary units for 'coordinate_e1e2u_v.nc' file 
     56      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations) 
     57      !                                   !  workspaces 
     58      REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw  
     59      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv 
     60      !!---------------------------------------------------------------------- 
     61      ! 
     62      IF( nn_timing == 1 )  CALL timing_start('dom_wri_coordinate') 
     63      ! 
     64      IF(lwp) WRITE(numout,*) 
     65      IF(lwp) WRITE(numout,*) 'dom_wri_coordinate : create NetCDF coordinate file' 
     66      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~' 
     67       
     68      clnam0 = 'coordinate_e1e2u_v'  ! filename (mesh and mask informations) 
     69       
     70      !  create 'coordinate_e1e2u_v.nc' file 
     71      ! ============================ 
     72      ! 
     73      CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 
     74      ! 
     75      !                                                         ! horizontal mesh (inum3) 
     76      CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r4 )     !    ! latitude 
     77      CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r4 ) 
     78      CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r4 ) 
     79      CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r4 ) 
     80       
     81      CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r4 )     !    ! longitude 
     82      CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r4 ) 
     83      CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r4 ) 
     84      CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r4 ) 
     85       
     86      CALL iom_rstput( 0, 0, inum0, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors 
     87      CALL iom_rstput( 0, 0, inum0, 'e1u', e1u, ktype = jp_r8 ) 
     88      CALL iom_rstput( 0, 0, inum0, 'e1v', e1v, ktype = jp_r8 ) 
     89      CALL iom_rstput( 0, 0, inum0, 'e1f', e1f, ktype = jp_r8 ) 
     90       
     91      CALL iom_rstput( 0, 0, inum0, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors 
     92      CALL iom_rstput( 0, 0, inum0, 'e2u', e2u, ktype = jp_r8 ) 
     93      CALL iom_rstput( 0, 0, inum0, 'e2v', e2v, ktype = jp_r8 ) 
     94      CALL iom_rstput( 0, 0, inum0, 'e2f', e2f, ktype = jp_r8 ) 
     95       
     96      CALL iom_rstput( 0, 0, inum0, 'e1e2u', e1e2u, ktype = jp_r8 ) 
     97      CALL iom_rstput( 0, 0, inum0, 'e1e2v', e1e2v, ktype = jp_r8 ) 
     98 
     99      CALL iom_close( inum0 ) 
     100      ! 
     101      IF( nn_timing == 1 )  CALL timing_stop('dom_wri_coordinate') 
     102      ! 
     103   END SUBROUTINE dom_wri_coordinate 
     104 
    38105 
    39106   SUBROUTINE dom_wri 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r5516 r5737  
    121121                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)       & 
    122122                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)  )    & 
    123                   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     123                  / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    124124            END DO 
    125125         END DO 
     
    195195            DO ji = 1, fs_jpim1   ! vector opt. 
    196196               rotn(ji,jj,jk) = (  zwv(ji+1,jj  ) - zwv(ji,jj)      & 
    197                   &              - zwu(ji  ,jj+1) + zwu(ji,jj)  ) * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) ) 
     197                  &              - zwu(ji  ,jj+1) + zwu(ji,jj)  ) * fmask(ji,jj,jk) * r1_e1e2f(ji,jj) 
    198198            END DO 
    199199         END DO 
     
    203203            ii = nicoa(jl,1,jk) 
    204204            ij = njcoa(jl,1,jk) 
    205             rotn(ii,ij,jk) = 1. / ( e1f(ii,ij) * e2f(ii,ij) )   & 
    206                            * ( + 4. * zwv(ii+1,ij) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) ) 
     205            rotn(ii,ij,jk) = r1_e1e2f(ji,jj) * ( + 4. * zwv(ii+1,ij) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) ) 
    207206         END DO 
    208207         DO jl = 1, npcoa(2,jk) 
    209208            ii = nicoa(jl,2,jk) 
    210209            ij = njcoa(jl,2,jk) 
    211             rotn(ii,ij,jk) = 1./(e1f(ii,ij)*e2f(ii,ij))   & 
    212                *(-4.*zwv(ii,ij)+zwv(ii-1,ij)-0.2*zwv(ii-2,ij)) 
     210            rotn(ii,ij,jk) = r1_e1e2f(ji,jj) * (-4.*zwv(ii,ij)+zwv(ii-1,ij)-0.2*zwv(ii-2,ij)) 
    213211         END DO 
    214212         DO jl = 1, npcoa(3,jk) 
    215213            ii = nicoa(jl,3,jk) 
    216214            ij = njcoa(jl,3,jk) 
    217             rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   & 
    218                * ( +4. * zwu(ii,ij+1) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) ) 
     215            rotn(ii,ij,jk) = -r1_e1e2f(ji,jj) * ( +4. * zwu(ii,ij+1) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) ) 
    219216         END DO 
    220217         DO jl = 1, npcoa(4,jk) 
    221218            ii = nicoa(jl,4,jk) 
    222219            ij = njcoa(jl,4,jk) 
    223             rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   & 
    224                * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) ) 
     220            rotn(ii,ij,jk) = -r1_e1e2f(ji,jj) * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) ) 
    225221         END DO 
    226222         !                                             ! =============== 
     
    302298                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)       & 
    303299                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)  )    & 
    304                   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     300                  / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    305301            END DO   
    306302         END DO   
     
    320316               rotn(ji,jj,jk) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
    321317                  &              - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
    322                   &           * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj) ) 
     318                  &           * fmask(ji,jj,jk) * r1_e1e2f(ji,jj) 
    323319            END DO 
    324320         END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r4990 r5737  
    9090         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes 
    9191            DO ji = fs_2, fs_jpim1   ! vector opt. 
    92                zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    93                zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
     92               zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) 
     93               zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) 
    9494               ! 
    9595               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj  ,jk) - zfu_t(ji  ,jj  ,jk)    & 
     
    114114      DO jk = 1, jpkm1                       ! ==================== ! 
    115115         !                                         ! Vertical volume fluxesÊ 
    116          zfw(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk) 
     116         zfw(:,:,jk) = 0.25 * e1e2t(:,:) * wn(:,:,jk) 
    117117         ! 
    118118         IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes                    
     
    144144            DO ji = fs_2, fs_jpim1   ! vector opt. 
    145145               ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) )    & 
    146                   &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     146                  &  / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    147147               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    & 
    148                   &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     148                  &  / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    149149            END DO 
    150150         END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r5069 r5737  
    181181         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes 
    182182            DO ji = fs_2, fs_jpim1   ! vector opt. 
    183                zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    184                zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
     183               zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) 
     184               zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) 
    185185               ! 
    186186               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj  ,jk) - zfu_t(ji  ,jj  ,jk)    & 
     
    203203      DO jk = 1, jpkm1                       ! ==================== ! 
    204204         !                                         ! Vertical volume fluxesÊ 
    205          zfw(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk) 
     205         zfw(:,:,jk) = 0.25 * e1e2t(:,:) * wn(:,:,jk) 
    206206         ! 
    207207         IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes                    
     
    233233            DO ji = fs_2, fs_jpim1   ! vector opt. 
    234234               ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) )    & 
    235                   &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     235                  &  / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    236236               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    & 
    237                   &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     237                  &  / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    238238            END DO 
    239239         END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r5224 r5737  
    10461046      DO jj = 2, jpjm1 
    10471047        DO ji = 2, jpim1 
    1048           zsshu_n(ji,jj) = (e12u(ji,jj) * sshn(ji,jj) + e12u(ji+1, jj) * sshn(ji+1,jj)) * & 
    1049                          & r1_e12u(ji,jj) * umask(ji,jj,1) * 0.5_wp  
    1050           zsshv_n(ji,jj) = (e12v(ji,jj) * sshn(ji,jj) + e12v(ji+1, jj) * sshn(ji,jj+1)) * & 
    1051                          & r1_e12v(ji,jj) * vmask(ji,jj,1) * 0.5_wp  
     1048          zsshu_n(ji,jj) = (e1e2u(ji,jj) * sshn(ji,jj) + e1e2u(ji+1, jj) * sshn(ji+1,jj)) * & 
     1049                         & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp  
     1050          zsshv_n(ji,jj) = (e1e2v(ji,jj) * sshn(ji,jj) + e1e2v(ji+1, jj) * sshn(ji,jj+1)) * & 
     1051                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp  
    10521052        END DO 
    10531053      END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    r4990 r5737  
    113113               DO ji = fs_2, fs_jpim1   ! vector opt. 
    114114                  zlu(ji,jj,jk) = - ( zuf(ji,jj,jk) - zuf(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
    115                      &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) / e1u(ji,jj) 
     115                     &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) * r1_e1u(ji,jj) 
    116116    
    117117                  zlv(ji,jj,jk) = + ( zuf(ji,jj,jk) - zuf(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
    118                      &         + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) / e2v(ji,jj) 
     118                     &         + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) * r1_e2v(ji,jj) 
    119119               END DO 
    120120            END DO 
     
    122122            DO jj = 2, jpjm1 
    123123               DO ji = fs_2, fs_jpim1   ! vector opt. 
    124                   zlu(ji,jj,jk) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) / e2u(ji,jj)   & 
    125                      &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj  ,jk) ) / e1u(ji,jj) 
    126     
    127                   zlv(ji,jj,jk) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) / e1v(ji,jj)   & 
    128                      &         + ( hdivb(ji,jj+1,jk) - hdivb(ji  ,jj,jk) ) / e2v(ji,jj) 
     124                  zlu(ji,jj,jk) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) * r1_e2u(ji,jj)   & 
     125                     &            + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj  ,jk) ) * r1_e1u(ji,jj) 
     126    
     127                  zlv(ji,jj,jk) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) * r1_e1v(ji,jj)   & 
     128                     &            + ( hdivb(ji,jj+1,jk) - hdivb(ji  ,jj,jk) ) * r1_e2v(ji,jj) 
    129129               END DO   
    130130            END DO   
     
    152152            DO ji = 1, fs_jpim1   ! vector opt. 
    153153               zuf(ji,jj,jk) = fmask(ji,jj,jk) * (  zcv(ji+1,jj  ) - zcv(ji,jj)      & 
    154                   &                            - zcu(ji  ,jj+1) + zcu(ji,jj)  )   & 
    155                   &       * fse3f(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) ) 
     154                  &                               - zcu(ji  ,jj+1) + zcu(ji,jj)  )   & 
     155                  &       * fse3f(ji,jj,jk) * r1_e1e2f(ji,jj) 
    156156            END DO   
    157157         END DO   
     
    168168         DO jj = 2, jpj 
    169169            DO ji = fs_2, jpi   ! vector opt. 
    170                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     170               zbt = e1e2t(ji,jj) * fse3t(ji,jj,jk) 
    171171               zut(ji,jj,jk) = (  zlu(ji,jj,jk) - zlu(ji-1,jj  ,jk)   & 
    172172                  &             + zlv(ji,jj,jk) - zlv(ji  ,jj-1,jk) ) / zbt 
     
    192192               ! horizontal biharmonic diffusive trends 
    193193               zua = - ( zuf(ji  ,jj,jk) - zuf(ji,jj-1,jk) ) / ze2u   & 
    194                   &  + ( zut(ji+1,jj,jk) - zut(ji,jj  ,jk) ) / e1u(ji,jj) 
     194                  &  + ( zut(ji+1,jj,jk) - zut(ji,jj  ,jk) ) * r1_e1u(ji,jj) 
    195195 
    196196               zva = + ( zuf(ji,jj  ,jk) - zuf(ji-1,jj,jk) ) / ze2v   & 
    197                   &  + ( zut(ji,jj+1,jk) - zut(ji  ,jj,jk) ) / e2v(ji,jj) 
     197                  &  + ( zut(ji,jj+1,jk) - zut(ji  ,jj,jk) ) * r1_e2v(ji,jj) 
    198198               ! add it to the general momentum trends 
    199199               ua(ji,jj,jk) = ua(ji,jj,jk) + zua * ( fsahmu(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90

    r4990 r5737  
    8080               ! horizontal diffusive trends 
    8181               zua = - ( ze2u - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk)*fse3f(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
    82                      + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v                   ) / e1u(ji,jj) 
     82                     + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v                   ) * r1_e1u(ji,jj) 
    8383 
    8484               zva = + ( ze2u - rotb (ji-1,jj,jk)*fsahmf(ji-1,jj,jk)*fse3f(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
    85                      + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v                   ) / e2v(ji,jj) 
     85                     + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v                   ) * r1_e2v(ji,jj) 
    8686 
    8787               ! add it to the general momentum trends 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r5656 r5737  
    108108   END FUNCTION dyn_spg_ts_alloc 
    109109 
     110 
    110111   SUBROUTINE dyn_spg_ts( kt ) 
    111112      !!---------------------------------------------------------------------- 
     
    338339         DO jj = 2, jpjm1 
    339340            DO ji = fs_2, fs_jpim1   ! vector opt. 
    340                zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj) 
    341                zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj) 
    342                zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj) 
    343                zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj) 
     341               zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj) 
     342               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj) 
     343               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj) 
     344               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj) 
    344345               ! energy conserving formulation for planetary vorticity term 
    345346               zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
     
    352353            DO ji = fs_2, fs_jpim1   ! vector opt. 
    353354               zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) & 
    354                  &            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj) 
     355                 &            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj) 
    355356               zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) & 
    356                  &            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) / e2v(ji,jj) 
     357                 &            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj) 
    357358               zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
    358359               zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) 
     
    363364         DO jj = 2, jpjm1 
    364365            DO ji = fs_2, fs_jpim1   ! vector opt. 
    365                zu_trd(ji,jj) = + z1_12 / e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) & 
    366                 &                                      + ftnw(ji+1,jj) * zwy(ji+1,jj  ) & 
    367                 &                                      + ftse(ji,jj  ) * zwy(ji  ,jj-1) & 
    368                 &                                      + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
    369                zv_trd(ji,jj) = - z1_12 / e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 
    370                 &                                      + ftse(ji,jj+1) * zwx(ji  ,jj+1) & 
    371                 &                                      + ftnw(ji,jj  ) * zwx(ji-1,jj  ) & 
    372                 &                                      + ftne(ji,jj  ) * zwx(ji  ,jj  ) ) 
     366               zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) & 
     367                &                                         + ftnw(ji+1,jj) * zwy(ji+1,jj  ) & 
     368                &                                         + ftse(ji,jj  ) * zwy(ji  ,jj-1) & 
     369                &                                         + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
     370               zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 
     371                &                                         + ftse(ji,jj+1) * zwx(ji  ,jj+1) & 
     372                &                                         + ftnw(ji,jj  ) * zwx(ji-1,jj  ) & 
     373                &                                         + ftne(ji,jj  ) * zwx(ji  ,jj  ) ) 
    373374            END DO 
    374375         END DO 
     
    381382         DO jj = 2, jpjm1  
    382383            DO ji = fs_2, fs_jpim1   ! vector opt. 
    383                zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) / e1u(ji,jj) 
    384                zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) / e2v(ji,jj) 
     384               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj) 
     385               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj) 
    385386            END DO 
    386387         END DO 
     
    431432            DO jj = 2, jpjm1               
    432433               DO ji = fs_2, fs_jpim1   ! vector opt. 
    433                   zu_spg =  grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) /e1u(ji,jj) 
    434                   zv_spg =  grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) /e2v(ji,jj) 
     434                  zu_spg =  grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj) 
     435                  zv_spg =  grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj) 
    435436                  zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 
    436437                  zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg 
     
    441442               DO ji = fs_2, fs_jpim1   ! vector opt. 
    442443                  zu_spg =  grav * z1_2 * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)    & 
    443                       &                    + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) /e1u(ji,jj) 
     444                      &                    + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj) 
    444445                  zv_spg =  grav * z1_2 * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)    & 
    445                       &                    + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) /e2v(ji,jj) 
     446                      &                    + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj) 
    446447                  zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 
    447448                  zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg 
     
    549550            DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points 
    550551               DO ji = 2, fs_jpim1   ! Vector opt. 
    551                   zwx(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e12u(ji,jj)     & 
    552                      &              * ( e12t(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
    553                      &              +   e12t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 
    554                   zwy(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e12v(ji,jj)     & 
    555                      &              * ( e12t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
    556                      &              +   e12t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 
     552                  zwx(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj)     & 
     553                     &              * ( e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
     554                     &              +   e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 
     555                  zwy(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj)     & 
     556                     &              * ( e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
     557                     &              +   e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 
    557558               END DO 
    558559            END DO 
     
    602603         ! Sum over sub-time-steps to compute advective velocities 
    603604         za2 = wgtbtp2(jn) 
    604          zu_sum  (:,:) = zu_sum  (:,:) + za2 * zwx  (:,:) / e2u  (:,:) 
    605          zv_sum  (:,:) = zv_sum  (:,:) + za2 * zwy  (:,:) / e1v  (:,:) 
     605         zu_sum(:,:) = zu_sum(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 
     606         zv_sum(:,:) = zv_sum(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 
    606607         ! 
    607608         ! Set next sea level: 
     
    609610            DO ji = fs_2, fs_jpim1   ! vector opt. 
    610611               zhdiv(ji,jj) = (   zwx(ji,jj) - zwx(ji-1,jj)   & 
    611                   &             + zwy(ji,jj) - zwy(ji,jj-1)   ) * r1_e12t(ji,jj) 
     612                  &             + zwy(ji,jj) - zwy(ji,jj-1)   ) * r1_e1e2t(ji,jj) 
    612613            END DO 
    613614         END DO 
     
    627628            DO jj = 2, jpjm1 
    628629               DO ji = 2, jpim1      ! NO Vector Opt. 
    629                   zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e12u(ji,jj)  & 
    630                      &              * ( e12t(ji  ,jj  ) * ssha_e(ji  ,jj  ) & 
    631                      &              +   e12t(ji+1,jj  ) * ssha_e(ji+1,jj  ) ) 
    632                   zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e12v(ji,jj)  & 
    633                      &              * ( e12t(ji  ,jj  ) * ssha_e(ji  ,jj  ) & 
    634                      &              +   e12t(ji  ,jj+1) * ssha_e(ji  ,jj+1) ) 
     630                  zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj)  & 
     631                     &              * ( e1e2t(ji  ,jj  ) * ssha_e(ji  ,jj  ) & 
     632                     &              +   e1e2t(ji+1,jj  ) * ssha_e(ji+1,jj  ) ) 
     633                  zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj)  & 
     634                     &              * ( e1e2t(ji  ,jj  ) * ssha_e(ji  ,jj  ) & 
     635                     &              +   e1e2t(ji  ,jj+1) * ssha_e(ji  ,jj+1) ) 
    635636               END DO 
    636637            END DO 
     
    666667            DO jj = 2, jpjm1                             
    667668               DO ji = 2, jpim1 
    668                   zx1 = z1_2 * umask(ji  ,jj,1) *  r1_e12u(ji  ,jj)    & 
    669                      &      * ( e12t(ji  ,jj  ) * zsshp2_e(ji  ,jj)    & 
    670                      &      +   e12t(ji+1,jj  ) * zsshp2_e(ji+1,jj  ) ) 
    671                   zy1 = z1_2 * vmask(ji  ,jj,1) *  r1_e12v(ji  ,jj  )  & 
    672                      &       * ( e12t(ji ,jj  ) * zsshp2_e(ji  ,jj  )  & 
    673                      &       +   e12t(ji ,jj+1) * zsshp2_e(ji  ,jj+1) ) 
     669                  zx1 = z1_2 * umask(ji  ,jj,1) *  r1_e1e2u(ji  ,jj)    & 
     670                     &      * ( e1e2t(ji  ,jj  ) * zsshp2_e(ji  ,jj)    & 
     671                     &      +   e1e2t(ji+1,jj  ) * zsshp2_e(ji+1,jj  ) ) 
     672                  zy1 = z1_2 * vmask(ji  ,jj,1) *  r1_e1e2v(ji  ,jj  )  & 
     673                     &       * ( e1e2t(ji ,jj  ) * zsshp2_e(ji  ,jj  )  & 
     674                     &       +   e1e2t(ji ,jj+1) * zsshp2_e(ji  ,jj+1) ) 
    674675                  zhust_e(ji,jj) = hu_0(ji,jj) + zx1  
    675676                  zhvst_e(ji,jj) = hv_0(ji,jj) + zy1 
     
    688689            DO jj = 2, jpjm1 
    689690               DO ji = fs_2, fs_jpim1   ! vector opt. 
    690                   zy1 = ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj) 
    691                   zy2 = ( zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj) 
    692                   zx1 = ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) ) / e2v(ji,jj) 
    693                   zx2 = ( zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) / e2v(ji,jj) 
     691                  zy1 = ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj) 
     692                  zy2 = ( zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj) 
     693                  zx1 = ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj) 
     694                  zx2 = ( zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj) 
    694695                  zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
    695696                  zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
     
    701702               DO ji = fs_2, fs_jpim1   ! vector opt. 
    702703                  zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) & 
    703                    &             + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj) 
     704                   &             + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj) 
    704705                  zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) & 
    705                    &             + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) / e2v(ji,jj) 
     706                   &             + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj) 
    706707                  zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
    707708                  zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) 
     
    712713            DO jj = 2, jpjm1 
    713714               DO ji = fs_2, fs_jpim1   ! vector opt. 
    714                   zu_trd(ji,jj) = + z1_12 / e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) & 
    715                      &                                    + ftnw(ji+1,jj) * zwy(ji+1,jj  ) & 
    716                      &                                    + ftse(ji,jj  ) * zwy(ji  ,jj-1) &  
    717                      &                                    + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
    718                   zv_trd(ji,jj) = - z1_12 / e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &  
    719                      &                                    + ftse(ji,jj+1) * zwx(ji  ,jj+1) & 
    720                      &                                    + ftnw(ji,jj  ) * zwx(ji-1,jj  ) &  
    721                      &                                    + ftne(ji,jj  ) * zwx(ji  ,jj  ) ) 
     715                  zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) & 
     716                     &                                       + ftnw(ji+1,jj) * zwy(ji+1,jj  ) & 
     717                     &                                       + ftse(ji,jj  ) * zwy(ji  ,jj-1) &  
     718                     &                                       + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
     719                  zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &  
     720                     &                                       + ftse(ji,jj+1) * zwx(ji  ,jj+1) & 
     721                     &                                       + ftnw(ji,jj  ) * zwx(ji-1,jj  ) &  
     722                     &                                       + ftne(ji,jj  ) * zwx(ji  ,jj  ) ) 
    722723               END DO 
    723724            END DO 
     
    729730            DO jj = 2, jpjm1 
    730731               DO ji = fs_2, fs_jpim1   ! vector opt. 
    731                   zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj) 
    732                   zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj) 
     732                  zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
     733                  zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
    733734                  zu_trd(ji,jj) = zu_trd(ji,jj) + zu_spg 
    734735                  zv_trd(ji,jj) = zv_trd(ji,jj) + zv_spg 
     
    745746            DO ji = fs_2, fs_jpim1   ! vector opt. 
    746747               ! Add surface pressure gradient 
    747                zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) / e1u(ji,jj) 
    748                zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) / e2v(ji,jj) 
     748               zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 
     749               zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 
    749750               zwx(ji,jj) = zu_spg 
    750751               zwy(ji,jj) = zv_spg 
     
    850851         DO jj = 1, jpjm1 
    851852            DO ji = 1, jpim1      ! NO Vector Opt. 
    852                zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e12u(ji,jj) & 
    853                   &              * ( e12t(ji  ,jj) * ssha(ji  ,jj)    & 
    854                   &              +   e12t(ji+1,jj) * ssha(ji+1,jj) ) 
    855                zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e12v(ji,jj) & 
    856                   &              * ( e12t(ji,jj  ) * ssha(ji,jj  )    & 
    857                   &              +   e12t(ji,jj+1) * ssha(ji,jj+1) ) 
     853               zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj) & 
     854                  &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)    & 
     855                  &              +   e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 
     856               zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj) & 
     857                  &              * ( e1e2t(ji,jj  ) * ssha(ji,jj  )    & 
     858                  &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 
    858859            END DO 
    859860         END DO 
     
    10931094         DO jj = 1, jpj 
    10941095            DO ji =1, jpi 
    1095                zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 
    1096                zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 
    1097                zcu(ji,jj) = sqrt(grav*ht_0(ji,jj)*(zxr2 + zyr2) ) 
     1096               zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
     1097               zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) 
     1098               zcu(ji,jj) = SQRT( grav * ht_0(ji,jj) * (zxr2 + zyr2) ) 
    10981099            END DO 
    10991100         END DO 
     
    11011102         DO jj = 1, jpj 
    11021103            DO ji =1, jpi 
    1103                zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 
    1104                zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 
    1105                zcu(ji,jj) = sqrt(grav*ht(ji,jj)*(zxr2 + zyr2) ) 
    1106             END DO 
    1107          END DO 
    1108       ENDIF 
    1109  
    1110       zcmax = MAXVAL(zcu(:,:)) 
     1104               zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
     1105               zyr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
     1106               zcu(ji,jj) = SQRT( grav * ht(ji,jj) * (zxr2 + zyr2) ) 
     1107            END DO 
     1108         END DO 
     1109      ENDIF 
     1110 
     1111      zcmax = MAXVAL( zcu(:,:) ) 
    11111112      IF( lk_mpp )   CALL mpp_max( zcmax ) 
    11121113 
     
    11141115      IF (ln_bt_nn_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 
    11151116       
    1116       rdtbt = rdt / FLOAT(nn_baro) 
     1117      rdtbt = rdt / REAL( nn_baro , wp ) 
    11171118      zcmax = zcmax * rdtbt 
    11181119                     ! Print results 
     
    11941195   !!====================================================================== 
    11951196END MODULE dynspg_ts 
    1196  
    1197  
    1198  
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r5029 r5737  
    213213      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    214214      !!---------------------------------------------------------------------- 
    215       ! 
    216215      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    217216      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
     
    237236      zfact2 = 0.5 * 0.5      ! Local constant initialization 
    238237 
    239 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz ) 
    240238      !                                                ! =============== 
    241239      DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    252250                  zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    253251                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    254                        &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) 
     252                       &     * 0.5 * r1_e1e2f(ji,jj) 
    255253               END DO 
    256254            END DO 
     
    262260                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    263261                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    264                        &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                               & 
     262                       &       * 0.5 * r1_e1e2f(ji,jj)                                              & 
    265263                       &       ) 
    266264               END DO 
     
    285283               zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1) 
    286284               zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1) 
    287                pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2 / e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
    288                pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 / e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )  
     285               pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
     286               pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )  
    289287            END DO   
    290288         END DO   
     
    365363                     zww(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    366364                        &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    367                         &       * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) * fse3f(ji,jj,jk) ) 
     365                        &       * 0.5 / ( e1e2f (ji,jj) * fse3f(ji,jj,jk) ) 
    368366                  END DO 
    369367               END DO 
     
    380378                     zww(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    381379                        &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    382                         &       * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) ) 
     380                        &       * 0.5 * r1_e1e2f(ji,jj) 
    383381                  END DO 
    384382               END DO 
     
    393391         DO jj = 2, jpjm1 
    394392            DO ji = fs_2, fs_jpim1   ! vector opt. 
    395                zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj) 
    396                zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj) 
    397                zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj) 
    398                zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj) 
     393               zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj) 
     394               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj) 
     395               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj) 
     396               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj) 
    399397               ! enstrophy conserving formulation for relative vorticity term 
    400398               zua = zfact1 * ( zww(ji  ,jj-1) + zww(ji,jj) ) * ( zy1 + zy2 ) 
     
    481479                  zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    482480                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    483                        &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) 
     481                       &     * 0.5 * r1_e1e2f(ji,jj) 
    484482               END DO 
    485483            END DO 
     
    491489                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    492490                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    493                        &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                                & 
     491                       &       * 0.5 * r1_e1e2f(ji,jj)                                                & 
    494492                       &       ) 
    495493               END DO 
     
    497495         END SELECT 
    498496         ! 
    499          IF( ln_sco ) THEN 
    500             DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop  
    501                DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking 
    502                   zwz(ji,jj) = zwz(ji,jj) / fse3f(ji,jj,jk) 
    503                   zwx(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) 
    504                   zwy(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) 
    505                END DO 
    506             END DO 
     497         IF( ln_sco ) THEN                   !==  horizontal fluxes  ==! 
     498            zwz(:,:) = zwz(:,:) / fse3f(:,:,jk) 
     499            zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
     500            zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    507501         ELSE 
    508             DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop  
    509                DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking 
    510                   zwx(ji,jj) = e2u(ji,jj) * un(ji,jj,jk) 
    511                   zwy(ji,jj) = e1v(ji,jj) * vn(ji,jj,jk) 
    512                END DO 
    513             END DO 
    514          ENDIF 
    515          ! 
    516          ! Compute and add the vorticity term trend 
    517          ! ---------------------------------------- 
     502            zwx(:,:) = e2u(:,:) * un(:,:,jk) 
     503            zwy(:,:) = e1v(:,:) * vn(:,:,jk) 
     504         ENDIF 
     505         !                                   !==  compute and add the vorticity term trend  =! 
    518506         DO jj = 2, jpjm1 
    519507            DO ji = fs_2, fs_jpim1   ! vector opt. 
    520                zuav = zfact1 / e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   & 
    521                   &                         + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) 
    522                zvau =-zfact1 / e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   & 
    523                   &                         + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) 
     508               zuav = zfact1 * r1_e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   & 
     509                  &                            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) 
     510               zvau =-zfact1 * r1_e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   & 
     511                  &                            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) 
    524512               pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
    525513               pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) 
     
    553541      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
    554542      !!---------------------------------------------------------------------- 
    555       ! 
    556543      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    557544      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
     
    627614      zfac12 = 1._wp / 12._wp    ! Local constant initialization 
    628615 
    629        
    630 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse ) 
    631616      !                                                ! =============== 
    632617      DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    645630                  zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    646631                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    647                        &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk) 
     632                       &     * 0.5 * r1_e1e2f(ji,jj) * ze3f(ji,jj,jk) 
    648633               END DO 
    649634            END DO 
     
    657642                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    658643                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    659                        &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                                & 
    660                        &       ) * ze3f(ji,jj,jk) 
     644                       &       * 0.5 * r1_e1e2f(ji,jj)   ) * ze3f(ji,jj,jk) 
    661645               END DO 
    662646            END DO 
    663647            CALL lbc_lnk( zwz, 'F', 1. ) 
    664648         END SELECT 
    665  
     649         ! 
     650         !                                   !==  horizontal fluxes  ==! 
    666651         zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
    667652         zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    668653 
    669          ! Compute and add the vorticity term trend 
    670          ! ---------------------------------------- 
     654         !                                   !==  compute and add the vorticity term trend  =! 
    671655         jj = 2 
    672656         ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0 
    673          DO ji = 2, jpi    
     657         DO ji = 2, jpi          ! split in 2 parts due to vector opt. 
    674658               ztne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
    675659               ztnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  ) 
     
    687671         DO jj = 2, jpjm1 
    688672            DO ji = fs_2, fs_jpim1   ! vector opt. 
    689                zua = + zfac12 / e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   & 
     673               zua = + zfac12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   & 
    690674                  &                           + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
    691                zva = - zfac12 / e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   & 
     675               zva = - zfac12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   & 
    692676                  &                           + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) ) 
    693677               pua(ji,jj,jk) = pua(ji,jj,jk) + zua 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r5120 r5737  
    8585         DO jj = 2, jpj                   ! vertical fluxes  
    8686            DO ji = fs_2, jpi             ! vector opt. 
    87                zww(ji,jj) = 0.25_wp * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) 
     87               zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 
    8888            END DO 
    8989         END DO 
     
    121121            DO ji = fs_2, fs_jpim1       ! vector opt. 
    122122               !                         ! vertical momentum advective trends 
    123                zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    124                zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     123               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     124               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    125125               !                         ! add the trends to the general momentum trends 
    126126               ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
     
    146146      ! 
    147147   END SUBROUTINE dyn_zad 
     148 
    148149 
    149150   SUBROUTINE dyn_zad_zts ( kt ) 
     
    205206         DO jj = 2, jpj                    
    206207            DO ji = fs_2, jpi             ! vector opt. 
    207                zww(ji,jj,jk) = 0.25_wp * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) 
     208               zww(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 
    208209            END DO 
    209210         END DO 
     
    251252               DO ji = fs_2, fs_jpim1       ! vector opt. 
    252253                  !                         ! vertical momentum advective trends 
    253                   zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    254                   zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     254                  zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     255                  zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    255256                  zus(ji,jj,jk,jta) = zus(ji,jj,jk,jtb) + zua * zts 
    256257                  zvs(ji,jj,jk,jta) = zvs(ji,jj,jk,jtb) + zva * zts 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r5656 r5737  
    193193            DO jj = 2, jpjm1 
    194194               DO ji = fs_2, fs_jpim1   ! vector opt. 
    195                   zhdiv(ji,jj,jk) = r1_e12t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 
     195                  zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 
    196196               END DO 
    197197            END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90

    r4328 r5737  
    125125 
    126126            ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too. 
    127             zsurfz = e1t(iiloc(jfl),ijloc(jfl)) * e2t(iiloc(jfl),ijloc(jfl)) 
     127            zsurfz =          e1e2t(iiloc(jfl),ijloc(jfl)) 
    128128            zvol   = zsurfz * fse3t(iiloc(jfl),ijloc(jfl),-ikl(jfl)) 
    129129 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90

    r5215 r5737  
    191191 
    192192         nbergs_end        = icb_utl_count() 
    193          zgrdd_berg_mass   = SUM( berg_mass (:,:)*e1e2t(:,:)*tmask_i(:,:) ) 
     193         zgrdd_berg_mass   = SUM( berg_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) ) 
    194194         zgrdd_bits_mass   = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) ) 
    195195 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90

    r5215 r5737  
    156156         ! use tmask rather than tmask_i when dealing with icebergs 
    157157         IF( tmask(ii,ij,1) /= 0._wp ) THEN    ! Add melting to the grid and field diagnostics 
    158             z1_e1e2    = 1._wp / e1e2t(ii,ij) * this%mass_scaling 
     158            z1_e1e2    = r1_e1e2t(ii,ij) * this%mass_scaling 
    159159            z1_dt_e1e2 = z1_dt * z1_e1e2 
    160160            zmelt    = ( zdM - ( zdMbitsE - zdMbitsM ) ) * z1_dt   ! kg/s 
     
    195195            ! 
    196196         ELSE                            ! Diagnose mass distribution on grid 
    197             z1_e1e2 = 1._wp / e1e2t(ii,ij) * this%mass_scaling 
     197            z1_e1e2 = r1_e1e2t(ii,ij) * this%mass_scaling 
    198198            CALL icb_dia_size( ii, ij, zWn, zLn, zAbits,   & 
    199199            &                  this%mass_scaling, zMnew, znMbits, z1_e1e2) 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5656 r5737  
    129129         ! 
    130130         IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
    131             CALL iom_set_domain_attr("grid_T", area = e12t(nldi:nlei, nldj:nlej)) 
    132             CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej)) 
    133             CALL iom_set_domain_attr("grid_V", area = e12v(nldi:nlei, nldj:nlej)) 
    134             CALL iom_set_domain_attr("grid_W", area = e12t(nldi:nlei, nldj:nlej)) 
     131            CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej)) 
     132            CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej)) 
     133            CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej)) 
     134            CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej)) 
    135135            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 
    136136            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r5407 r5737  
    197197   END SUBROUTINE rst_read_open 
    198198 
     199 
    199200   SUBROUTINE rst_read 
    200201      !!----------------------------------------------------------------------  
     
    265266         hdivb(:,:,:)   = hdivn(:,:,:) 
    266267         sshb (:,:)     = sshn (:,:) 
    267  
     268         ! 
    268269         IF( lk_vvl ) THEN 
    269270            DO jk = 1, jpk 
     
    271272            END DO 
    272273         ENDIF 
    273  
     274         ! 
    274275      ENDIF 
    275276      ! 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r5120 r5737  
    208208               DO ji = fs_2, fs_jpim1   ! vector opt. 
    209209                  !                                      ! horizontal and vertical density gradient at u- and v-points 
    210                   zau = zgru(ji,jj,jk) / e1u(ji,jj) 
    211                   zav = zgrv(ji,jj,jk) / e2v(ji,jj) 
     210                  zau = zgru(ji,jj,jk) * r1_e1u(ji,jj) 
     211                  zav = zgrv(ji,jj,jk) * r1_e2v(ji,jj) 
    212212                  zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) ) 
    213213                  zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) ) 
     
    426426         DO jj = 2, jpjm1  
    427427            DO ji = fs_2, fs_jpim1   ! vector opt.  
    428                uslp(ji,jj,1) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,1) - fsdept_b(ji ,jj ,1) ) * umask(ji,jj,1)  
    429                vslp(ji,jj,1) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,1) - fsdept_b(ji ,jj ,1) ) * vmask(ji,jj,1)  
    430                wslpi(ji,jj,1) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,1) - fsdepw_b(ji-1,jj,1) ) * tmask(ji,jj,1) * 0.5  
    431                wslpj(ji,jj,1) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,1) - fsdepw_b(ji,jj-1,1) ) * tmask(ji,jj,1) * 0.5  
     428               uslp (ji,jj,1) = -r1_e1u(ji,jj) * ( fsdept_b(ji+1,jj,1) - fsdept_b(ji ,jj ,1) ) * umask(ji,jj,1)  
     429               vslp (ji,jj,1) = -r1_e2v(ji,jj) * ( fsdept_b(ji,jj+1,1) - fsdept_b(ji ,jj ,1) ) * vmask(ji,jj,1)  
     430               wslpi(ji,jj,1) = -r1_e1t(ji,jj) * ( fsdepw_b(ji+1,jj,1) - fsdepw_b(ji-1,jj,1) ) * tmask(ji,jj,1) * 0.5  
     431               wslpj(ji,jj,1) = -r1_e2t(ji,jj) * ( fsdepw_b(ji,jj+1,1) - fsdepw_b(ji,jj-1,1) ) * tmask(ji,jj,1) * 0.5  
    432432            END DO  
    433433         END DO  
     
    436436            DO jj = 2, jpjm1  
    437437               DO ji = fs_2, fs_jpim1   ! vector opt.  
    438                   uslp(ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk)  
    439                   vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)  
    440                   wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) & 
    441                     &                              * wmask(ji,jj,jk) * 0.5  
    442                   wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) & 
    443                     &                              * wmask(ji,jj,jk) * 0.5  
     438                  uslp (ji,jj,jk) = -r1_e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk)  
     439                  vslp (ji,jj,jk) = -r1_e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)  
     440                  wslpi(ji,jj,jk) = -r1_e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * wmask(ji,jj,jk) * 0.5 
     441                  wslpj(ji,jj,jk) = -r1_e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * wmask(ji,jj,jk) * 0.5  
    444442               END DO  
    445443            END DO  
     
    519517                  zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! j-gradient of T & S at v-point 
    520518                  zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    521                   zdxrho_raw = ( - rab_b(ji+ip,jj   ,jk,jp_tem) * zdit + rab_b(ji+ip,jj   ,jk,jp_sal) * zdis ) / e1u(ji,jj) 
    522                   zdyrho_raw = ( - rab_b(ji   ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji   ,jj+jp,jk,jp_sal) * zdjs ) / e2v(ji,jj) 
     519                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,jk,jp_tem) * zdit + rab_b(ji+ip,jj   ,jk,jp_sal) * zdis ) * r1_e1u(ji,jj) 
     520                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji   ,jj+jp,jk,jp_sal) * zdjs ) * r1_e2v(ji,jj) 
    523521                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
    524522                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
     
    533531                  zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature 
    534532                  zdis = gtsu(ji,jj,jp_sal)   ;   zdjs = gtsv(ji,jj,jp_sal)      ! i- & j-gradient of Salinity 
    535                   zdxrho_raw = ( - rab_b(ji+ip,jj   ,iku,jp_tem) * zdit + rab_b(ji+ip,jj   ,iku,jp_sal) * zdis ) / e1u(ji,jj) 
    536                   zdyrho_raw = ( - rab_b(ji   ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji   ,jj+jp,ikv,jp_sal) * zdjs ) / e2v(ji,jj) 
     533                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,iku,jp_tem) * zdit + rab_b(ji+ip,jj   ,iku,jp_sal) * zdis ) * r1_e1u(ji,jj) 
     534                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji   ,jj+jp,ikv,jp_sal) * zdjs ) * r1_e2v(ji,jj) 
    537535                  zdxrho(ji+ip,jj   ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
    538536                  zdyrho(ji   ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
     
    593591                    ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 
    594592                    zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      & 
    595                        &      - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj)  ) * umask(ji,jj,jk) 
     593                       &      - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e1u(ji,jj)  ) * umask(ji,jj,jk) 
    596594                    zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 
    597595                  ENDIF 
     
    602600                  ELSE 
    603601                    ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      & 
    604                        &      - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk) 
     602                       &      - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e2v(ji,jj)  ) * vmask(ji,jj,jk) 
    605603                    ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 
    606604                  ENDIF 
     
    630628                     ! raw slopes: unmasked unbounded slopes (relative to geopotential (zti_g) and model surface (zti) 
    631629                     ! 
    632                      zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                   ! unmasked 
     630                     zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                             ! unmasked 
    633631                     ztj_raw   = zdyrho(ji   ,jj+jp,jk,1-jp) / zdzrho(ji   ,jj+jp,jk,kp) 
    634632 
    635633                     ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 
    636                      zti_coord = znot_thru_surface * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj) 
    637                      ztj_coord = znot_thru_surface * ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj)                  ! unmasked 
     634                     zti_coord = znot_thru_surface * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj) 
     635                     ztj_coord = znot_thru_surface * ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(ji,jj)     ! unmasked 
    638636                     zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces 
    639637                     ztj_g_raw = ztj_raw - ztj_coord 
     
    680678                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim 
    681679                    ! 
    682                      zbu = e1u(ji    ,jj) * e2u(ji   ,jj) * fse3u(ji   ,jj,jk   ) 
    683                      zbv = e1v(ji    ,jj) * e2v(ji   ,jj) * fse3v(ji   ,jj,jk   ) 
    684                      zbti = e1t(ji+ip,jj) * e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp) 
    685                      zbtj = e1t(ji,jj+jp) * e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp) 
     680                     zbu  = e1e2u(ji   ,jj) * fse3u(ji   ,jj,jk   ) 
     681                     zbv  = e1e2v(ji   ,jj) * fse3v(ji   ,jj,jk   ) 
     682                     zbti = e1e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp) 
     683                     zbtj = e1e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp) 
    686684                     ! 
    687685                     !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers....  ==> to be checked 
     
    782780            zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji  ,jj+1,ikv) ) 
    783781            !                        !- horizontal density gradient at u- & v-points 
    784             zau = p_gru(ji,jj,iku) / e1u(ji,jj) 
    785             zav = p_grv(ji,jj,ikv) / e2v(ji,jj) 
     782            zau = p_gru(ji,jj,iku) * r1_e1u(ji,jj) 
     783            zav = p_grv(ji,jj,ikv) * r1_e2v(ji,jj) 
    786784            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 
    787785            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
     
    877875               DO jj = 2, jpjm1 
    878876                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    879                      uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 
    880                      vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 
    881                      wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 
    882                      wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 
     877                     uslp (ji,jj,jk) = -r1_e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 
     878                     vslp (ji,jj,jk) = -r1_e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 
     879                     wslpi(ji,jj,jk) = -r1_e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * wmask(ji,jj,jk) * 0.5 
     880                     wslpj(ji,jj,jk) = -r1_e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * wmask(ji,jj,jk) * 0.5 
    883881                  END DO 
    884882               END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90

    r3294 r5737  
    2424   USE lib_mpp          ! MPP library 
    2525   USE dom_oce, ONLY : &                  ! Domain variables 
    26       &                    tmask, tmask_i, e1t, e2t, gphit, glamt 
     26      &                    tmask, tmask_i, e1e2t, gphit, glamt 
    2727   USE obs_const, ONLY :   obfillflt      ! Fillvalue 
    2828   USE oce      , ONLY :   sshn           ! Model variables 
     
    220220      DO jj = 1, jpj 
    221221         DO ji = 1, jpi 
    222           zdxdy = e1t(ji,jj) * e2t(ji,jj) * zpromsk(ji,jj) 
     222          zdxdy = e1e2t(ji,jj) * zpromsk(ji,jj) 
    223223          zarea = zarea + zdxdy 
    224224          zeta1 = zeta1 + mdt(ji,jj) * zdxdy 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r5516 r5737  
    6767   PRIVATE 
    6868 
    69    !! * Routine accessibility 
    7069   PUBLIC cice_sbc_init   ! routine called by sbc_init 
    7170   PUBLIC cice_sbc_final  ! routine called by sbc_final 
     
    9594   !! * Substitutions 
    9695#  include "domzgr_substitute.h90" 
    97  
     96   !!---------------------------------------------------------------------- 
     97   !! NEMO/OPA 3.7 , NEMO-consortium (2015)  
    9898   !! $Id$ 
     99   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     100   !!---------------------------------------------------------------------- 
    99101CONTAINS 
    100102 
     
    154156   END SUBROUTINE sbc_ice_cice 
    155157 
    156    SUBROUTINE cice_sbc_init (ksbc) 
     158 
     159   SUBROUTINE cice_sbc_init( ksbc ) 
    157160      !!--------------------------------------------------------------------- 
    158161      !!                    ***  ROUTINE cice_sbc_init  *** 
    159162      !! ** Purpose: Initialise ice related fields for NEMO and coupling 
    160163      !! 
     164      !!--------------------------------------------------------------------- 
    161165      INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type 
    162166      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 
     
    289293 
    290294    
    291    SUBROUTINE cice_sbc_in (kt, ksbc) 
     295   SUBROUTINE cice_sbc_in( kt, ksbc ) 
    292296      !!--------------------------------------------------------------------- 
    293297      !!                    ***  ROUTINE cice_sbc_in  *** 
     
    296300      INTEGER, INTENT(in   ) ::   kt   ! ocean time step 
    297301      INTEGER, INTENT(in   ) ::   ksbc ! surface forcing type 
    298  
     302      ! 
    299303      INTEGER  ::   ji, jj, jl                   ! dummy loop indices       
    300304      REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice 
     
    490494! x comp and y comp of sea surface slope (on F points) 
    491495! T point to F point 
    492       DO jj=1,jpjm1 
    493          DO ji=1,jpim1 
    494             ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  ))/e1u(ji,jj  )   & 
    495                                + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) &  
    496                             *  fmask(ji,jj,1) 
    497          ENDDO 
    498       ENDDO 
    499       CALL nemo2cice(ztmp,ss_tltx,'F', -1. ) 
     496      DO jj = 1, jpjm1 
     497         DO ji = 1, jpim1 
     498            ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  )) * r1_e1u(ji,jj  )    & 
     499               &               + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1)  ) * fmask(ji,jj,1) 
     500         END DO 
     501      END DO 
     502      CALL nemo2cice( ztmp,ss_tltx,'F', -1. ) 
    500503 
    501504! T point to F point 
    502       DO jj=1,jpjm1 
    503          DO ji=1,jpim1 
    504             ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj))/e2v(ji  ,jj)   & 
    505                                + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) & 
    506                             *  fmask(ji,jj,1) 
    507          ENDDO 
    508       ENDDO 
     505      DO jj = 1, jpjm1 
     506         DO ji = 1, jpim1 
     507            ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj)) * r1_e2v(ji  ,jj)    & 
     508               &               + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj)  ) *  fmask(ji,jj,1) 
     509         END DO 
     510      END DO 
    509511      CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 
    510512 
     
    517519 
    518520 
    519    SUBROUTINE cice_sbc_out (kt,ksbc) 
     521   SUBROUTINE cice_sbc_out( kt, ksbc ) 
    520522      !!--------------------------------------------------------------------- 
    521523      !!                    ***  ROUTINE cice_sbc_out  *** 
     
    575577! Update taum with modulus of ice-ocean stress  
    576578! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here  
    577 taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1**2. + ztmp2**2.)  
     579taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1*ztmp1 + ztmp2*ztmp2)  
    578580 
    579581! Freshwater fluxes  
     
    888890#endif 
    889891      !!--------------------------------------------------------------------- 
    890  
    891892      CHARACTER(len=1), INTENT( in ) ::   & 
    892893          cd_type       ! nature of pn grid-point 
     
    908909 
    909910      INTEGER  ::   ji, jj, jn                      ! dummy loop indices 
     911      !!--------------------------------------------------------------------- 
    910912 
    911913!     A. Ensure all haloes are filled in NEMO field (pn) 
     
    10961098   !!   Default option           Dummy module         NO CICE sea-ice model 
    10971099   !!---------------------------------------------------------------------- 
    1098    !! $Id$ 
    10991100CONTAINS 
    11001101 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90

    r4328 r5737  
    8989         DO ji = 2, jpim1 
    9090            zcoef = z2dt * z2dt * grav * bmask(ji,jj) 
    91             zcoefs = -zcoef * hv(ji  ,jj-1) * e1v(ji  ,jj-1) / e2v(ji  ,jj-1)    ! south coefficient 
    92             zcoefw = -zcoef * hu(ji-1,jj  ) * e2u(ji-1,jj  ) / e1u(ji-1,jj  )    ! west coefficient 
    93             zcoefe = -zcoef * hu(ji  ,jj  ) * e2u(ji  ,jj  ) / e1u(ji  ,jj  )    ! east coefficient 
    94             zcoefn = -zcoef * hv(ji  ,jj  ) * e1v(ji  ,jj  ) / e2v(ji  ,jj  )    ! north coefficient 
     91            zcoefs = -zcoef * hv(ji  ,jj-1) * e1_e2v(ji  ,jj-1)    ! south coefficient 
     92            zcoefw = -zcoef * hu(ji-1,jj  ) * e2_e1u(ji-1,jj  )    ! west coefficient 
     93            zcoefe = -zcoef * hu(ji  ,jj  ) * e2_e1u(ji  ,jj  )    ! east coefficient 
     94            zcoefn = -zcoef * hv(ji  ,jj  ) * e1_e2v(ji  ,jj  )    ! north coefficient 
    9595            gcp(ji,jj,1) = zcoefs 
    9696            gcp(ji,jj,2) = zcoefw 
    9797            gcp(ji,jj,3) = zcoefe 
    9898            gcp(ji,jj,4) = zcoefn 
    99             gcdmat(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * bmask(ji,jj)    &          ! diagonal coefficient 
     99            gcdmat(ji,jj) = e1e2t(ji,jj) * bmask(ji,jj)    &          ! diagonal coefficient 
    100100               &          - zcoefs -zcoefw -zcoefe -zcoefn 
    101101         END DO 
     
    110110 
    111111            !  south coefficient 
    112             zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1) 
     112            zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1) 
    113113            zcoefs = zcoefs * bdyvmask(ji,jj-1) 
    114114            gcp(ji,jj,1) = zcoefs 
    115115 
    116116            !  west coefficient 
    117             zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj) 
     117            zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj) 
    118118            zcoefw = zcoefw * bdyumask(ji-1,jj) 
    119119            gcp(ji,jj,2) = zcoefw 
    120120 
    121121            !  east coefficient 
    122             zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj) 
     122            zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj) 
    123123            zcoefe = zcoefe * bdyumask(ji,jj) 
    124124            gcp(ji,jj,3) = zcoefe 
    125125 
    126126            !  north coefficient 
    127             zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj) 
     127            zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj) 
    128128            zcoefn = zcoefn * bdyvmask(ji,jj) 
    129129            gcp(ji,jj,4) = zcoefn 
    130130 
    131131            ! diagonal coefficient 
    132             gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) & 
    133                             - zcoefs -zcoefw -zcoefe -zcoefn 
     132            gcdmat(ji,jj) = e1e2t(ji,jj)*bmask(ji,jj) - zcoefs -zcoefw -zcoefe -zcoefn 
    134133         END DO 
    135134      END DO 
     
    149148               !  south coefficient 
    150149               IF( ( nbondj == -1 .OR. nbondj == 2 ) .AND. ( jj == 3 ) ) THEN 
    151                   zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1)) 
     150                  zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1)) 
    152151               ELSE 
    153                   zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1) 
     152                  zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1) 
    154153               END IF 
    155154               gcp(ji,jj,1) = zcoefs 
     
    157156               !  west coefficient 
    158157               IF( ( nbondi == -1 .OR. nbondi == 2 ) .AND. ( ji == 3 )  ) THEN 
    159                   zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-umask(ji-1,jj,1)) 
     158                  zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj)*(1.-umask(ji-1,jj,1)) 
    160159               ELSE 
    161                   zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj) 
     160                  zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj) 
    162161               END IF 
    163162               gcp(ji,jj,2) = zcoefw 
     
    165164               !   east coefficient 
    166165               IF( ( nbondi == 1 .OR. nbondi == 2 ) .AND. ( ji == nlci-2 ) ) THEN 
    167                   zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-umask(ji,jj,1)) 
     166                  zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj)*(1.-umask(ji,jj,1)) 
    168167               ELSE 
    169                   zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj) 
     168                  zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj) 
    170169               END IF 
    171170               gcp(ji,jj,3) = zcoefe 
     
    173172               !   north coefficient 
    174173               IF( ( nbondj == 1 .OR. nbondj == 2 ) .AND. ( jj == nlcj-2 ) ) THEN 
    175                   zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vmask(ji,jj,1)) 
     174                  zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj)*(1.-vmask(ji,jj,1)) 
    176175               ELSE 
    177                   zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj) 
     176                  zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj) 
    178177               END IF 
    179178               gcp(ji,jj,4) = zcoefn 
    180179               ! 
    181180               ! diagonal coefficient 
    182                gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj)   & 
    183                   &            - zcoefs -zcoefw -zcoefe -zcoefn 
     181               gcdmat(ji,jj) = e1e2t(ji,jj)*bmask(ji,jj) - zcoefs -zcoefw -zcoefe -zcoefn 
    184182            END DO 
    185183         END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r5541 r5737  
    260260            DO jj = 2, jpjm1 
    261261               DO ji = fs_2, fs_jpim1   ! vector opt. 
    262                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) *  fse3t(ji,jj,jk) ) 
     262                  zbtr = 1. / ( e1e2t(ji,jj) *  fse3t(ji,jj,jk) ) 
    263263                  ! advective trends 
    264264                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r5656 r5737  
    148148            END DO 
    149149# if defined key_diaeiv  
    150             IF( cdtype == 'TRA')  w_eiv(:,:,jk) = zw_eiv(:,:) / ( e1t(:,:) * e2t(:,:) ) 
     150            IF( cdtype == 'TRA')  w_eiv(:,:,jk) = zw_eiv(:,:) / ( e1e2t(:,:) ) 
    151151# endif 
    152152         ENDIF 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    r5215 r5737  
    2828   PUBLIC   tra_adv_mle_init   ! routine called in traadv.F90 
    2929 
    30    !                                               !!* namelist namtra_adv_mle * 
     30   !                                       !!* namelist namtra_adv_mle * 
    3131   LOGICAL, PUBLIC ::   ln_mle              ! flag to activate the Mixed Layer Eddy (MLE) parameterisation 
    3232   INTEGER         ::   nn_mle              ! MLE type: =0 standard Fox-Kemper ; =1 new formulation 
     
    3434   INTEGER         ::   nn_conv             ! =1 no MLE in case of convection ; =0 always MLE 
    3535   REAL(wp)        ::   rn_ce               ! MLE coefficient 
    36    !                                           ! parameters used in nn_mle = 0 case 
     36   !                                        ! parameters used in nn_mle = 0 case 
    3737   REAL(wp)        ::   rn_lf                  ! typical scale of mixed layer front 
    38    REAL(wp)        ::   rn_time             ! time scale for mixing momentum across the mixed layer 
    39    !                                             ! parameters used in nn_mle = 1 case 
    40    REAL(wp)        ::   rn_lat                   ! reference latitude for a 5 km scale of ML front 
    41    REAL(wp)        ::   rn_rho_c_mle         ! Density criterion for definition of MLD used by FK 
     38   REAL(wp)        ::   rn_time                ! time scale for mixing momentum across the mixed layer 
     39   !                                        ! parameters used in nn_mle = 1 case 
     40   REAL(wp)        ::   rn_lat                 ! reference latitude for a 5 km scale of ML front 
     41   REAL(wp)        ::   rn_rho_c_mle           ! Density criterion for definition of MLD used by FK 
    4242 
    4343   REAL(wp) ::   r5_21 = 5.e0 / 21.e0   ! factor used in mle streamfunction computation 
     
    5252#  include "vectopt_loop_substitute.h90" 
    5353   !!---------------------------------------------------------------------- 
    54    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     54   !! NEMO/OPA 4.0 , NEMO Consortium (2015) 
    5555   !! $Id$ 
    5656   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     
    8080      !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008 
    8181      !!---------------------------------------------------------------------- 
    82       ! 
    8382      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
    8483      INTEGER                         , INTENT(in   ) ::   kit000     ! first time step index 
     
    9392      REAL(wp) ::   zcvw, zmvw   !   -      - 
    9493      REAL(wp) ::   zc                                     !   -      - 
    95  
     94      ! 
    9695      INTEGER  ::   ii, ij, ik              ! local integers 
    9796      INTEGER, DIMENSION(3) ::   ilocu      ! 
     
    101100      INTEGER, POINTER, DIMENSION(:,:) :: inml_mle 
    102101      !!---------------------------------------------------------------------- 
    103  
     102      ! 
    104103      IF( nn_timing == 1 )  CALL timing_start('tra_adv_mle') 
    105104      CALL wrk_alloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH) 
     
    171170         DO jj = 1, jpjm1 
    172171            DO ji = 1, fs_jpim1   ! vector opt. 
    173                zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2u(ji,jj)                                            & 
    174                   &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp          , e1u(ji,jj)                )   & 
    175                   &           / (         e1u(ji,jj)          * MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   ) 
     172               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            & 
     173                  &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   & 
     174                  &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   ) 
    176175                  ! 
    177                zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1v(ji,jj)                                            & 
    178                   &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp          , e2v(ji,jj)                )   & 
    179                   &           / (         e2v(ji,jj)          * MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   ) 
     176               zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1_e2v(ji,jj)                                            & 
     177                  &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )   & 
     178                  &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   ) 
    180179            END DO 
    181180         END DO 
     
    184183         DO jj = 1, jpjm1 
    185184            DO ji = 1, fs_jpim1   ! vector opt. 
    186                zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj) / e1u(ji,jj)          & 
     185               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               & 
    187186                  &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) 
    188187                  ! 
    189                zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1v(ji,jj) / e2v(ji,jj)          & 
     188               zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1_e2v(ji,jj)               & 
    190189                  &                  * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) 
    191190            END DO 
     
    252251         ! divide by cross distance to give streamfunction with dimensions m^2/s 
    253252         DO jk = 1, ikmax+1 
    254             zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk)/e2u(:,:) 
    255             zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk)/e1v(:,:) 
     253            zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk) * r1_e2u(:,:) 
     254            zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk) * r1_e1v(:,:) 
    256255         END DO 
    257256         CALL iom_put( "psiu_mle", zpsi_uw )    ! i-mle streamfunction 
     
    281280      NAMELIST/namtra_adv_mle/ ln_mle , nn_mle, rn_ce, rn_lf, rn_time, rn_lat, nn_mld_uv, nn_conv, rn_rho_c_mle 
    282281      !!---------------------------------------------------------------------- 
    283  
    284282 
    285283      REWIND( numnam_ref )              ! Namelist namtra_adv_mle in reference namelist : Tracer advection scheme 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r5147 r5737  
    182182                  z0u = SIGN( 0.5, pun(ji,jj,jk) ) 
    183183                  zalpha = 0.5 - z0u 
    184                   zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     184                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    185185                  zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 
    186186                  zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk) 
     
    189189                  z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 
    190190                  zalpha = 0.5 - z0v 
    191                   zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     191                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    192192                  zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 
    193193                  zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk) 
     
    203203            DO jj = 2, jpjm1       
    204204               DO ji = fs_2, fs_jpim1   ! vector opt. 
    205                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     205                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    206206                  ! horizontal advective trends 
    207207                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     
    262262            DO jj = 2, jpjm1       
    263263               DO ji = fs_2, fs_jpim1   ! vector opt. 
    264                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 
     264                  zbtr = 1. / ( e1e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 
    265265                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) 
    266266                  zalpha = 0.5 + z0w 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r5147 r5737  
    139139                  z0u = SIGN( 0.5, pun(ji,jj,jk) ) 
    140140                  zalpha = 0.5 - z0u 
    141                   zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     141                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    142142                  zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk) 
    143143                  zzwy = ptb(ji  ,jj,jk,jn) + zu * zslpx(ji  ,jj,jk) 
     
    146146                  z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 
    147147                  zalpha = 0.5 - z0v 
    148                   zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     148                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    149149                  zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk) 
    150150                  zzwy = ptb(ji,jj  ,jk,jn) + zv * zslpy(ji,jj  ,jk) 
     
    183183            DO jj = 2, jpjm1 
    184184               DO ji = fs_2, fs_jpim1   ! vector opt. 
    185                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     185                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    186186                  ! horizontal advective trends  
    187187                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     
    243243            DO jj = 2, jpjm1 
    244244               DO ji = fs_2, fs_jpim1   ! vector opt. 
    245                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 
     245                  zbtr = 1. / ( e1e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 
    246246                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) 
    247247                  zalpha = 0.5 + z0w 
     
    269269            DO jj = 2, jpjm1       
    270270               DO ji = fs_2, fs_jpim1   ! vector opt. 
    271                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     271                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    272272                  ! vertical advective trends  
    273273                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r5147 r5737  
    220220            DO jj = 2, jpjm1 
    221221               DO ji = fs_2, fs_jpim1   ! vector opt.   
    222                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     222                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    223223                  ! horizontal advective trends 
    224224                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) 
     
    344344            DO jj = 2, jpjm1 
    345345               DO ji = fs_2, fs_jpim1   ! vector opt.   
    346                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     346                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    347347                  ! horizontal advective trends 
    348348                  ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) 
     
    407407            DO jj = 2, jpjm1 
    408408               DO ji = fs_2, fs_jpim1   ! vector opt. 
    409                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     409                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    410410                  ! k- vertical advective trends  
    411411                  ztra = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )  
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r5147 r5737  
    173173            DO jj = 2, jpjm1 
    174174               DO ji = fs_2, fs_jpim1   ! vector opt. 
    175                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     175                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    176176                  ! total intermediate advective trends 
    177177                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     
    242242            DO jj = 2, jpjm1 
    243243               DO ji = fs_2, fs_jpim1   ! vector opt.   
    244                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     244                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    245245                  ! total advective trends 
    246246                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     
    278278   END SUBROUTINE tra_adv_tvd 
    279279 
     280 
    280281   SUBROUTINE tra_adv_tvd_zts ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      & 
    281282      &                                       ptb, ptn, pta, kjpt ) 
     
    410411            DO jj = 2, jpjm1 
    411412               DO ji = fs_2, fs_jpim1   ! vector opt. 
    412                   zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     413                  zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    413414                  ! total intermediate advective trends 
    414415                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     
    504505               DO jj = 2, jpjm1 
    505506                  DO ji = fs_2, fs_jpim1 
    506                      zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     507                     zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    507508                     ! total advective trends 
    508509                     ztra = - zbtr * (  zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) 
     
    534535            DO jj = 2, jpjm1 
    535536               DO ji = fs_2, fs_jpim1   ! vector opt.   
    536                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     537                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    537538                  ! total advective trends 
    538539                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     
    572573   END SUBROUTINE tra_adv_tvd_zts 
    573574 
     575 
    574576   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) 
    575577      !!--------------------------------------------------------------------- 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r5147 r5737  
    118118            DO jj = 1, jpjm1            ! First derivative (gradient) 
    119119               DO ji = 1, fs_jpim1   ! vector opt. 
    120                   zeeu = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk) 
    121                   zeev = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk) 
     120                  zeeu = e2_e1u(ji,jj) * fse3u(ji,jj,jk) * umask(ji,jj,jk) 
     121                  zeev = e1_e2v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk) 
    122122                  ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) 
    123123                  ztv(ji,jj,jk) = zeev * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
     
    250250               DO jj = 2, jpjm1 
    251251                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    252                      zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     252                     zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    253253                     z_hdivn = (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  ) * zbtr 
    254254                     zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk) + ptn(ji,jj,jk,jn) * z_hdivn 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r4990 r5737  
    2929   USE phycst         ! physical constant 
    3030   USE eosbn2         ! equation of state 
    31    USE trd_oce     ! trends: ocean variables 
     31   USE trd_oce        ! trends: ocean variables 
    3232   USE trdtra         ! trends: active tracers 
    3333   ! 
     
    198198         DO jj = 1, jpj 
    199199            DO ji = 1, jpi 
    200                ik = mbkt(ji,jj)                              ! bottom T-level index 
    201                zptb(ji,jj) = ptb(ji,jj,ik,jn)       ! bottom before T and S 
     200               ik = mbkt(ji,jj)                             ! bottom T-level index 
     201               zptb(ji,jj) = ptb(ji,jj,ik,jn)               ! bottom before T and S 
    202202            END DO 
    203203         END DO 
     
    205205         DO jj = 2, jpjm1                                    ! Compute the trend 
    206206            DO ji = 2, jpim1 
    207                ik = mbkt(ji,jj)                              ! bottom T-level index 
    208                zbtr = r1_e12t(ji,jj)  / fse3t(ji,jj,ik) 
    209                pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         & 
    210                   &               + (   ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   & 
    211                   &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   & 
    212                   &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   & 
    213                   &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr 
     207               ik = mbkt(ji,jj)                            ! bottom T-level index 
     208               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                  & 
     209                  &             + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     & 
     210                  &                - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     & 
     211                  &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     & 
     212                  &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  & 
     213                  &             / ( e1e2t(ji,jj) * fse3t(ji,jj,ik) ) 
    214214            END DO 
    215215         END DO 
     
    263263                  ! 
    264264                  !                                               ! up  -slope T-point (shelf bottom point) 
    265                   zbtr = r1_e12t(iis,jj) / fse3t(iis,jj,ikus) 
     265                  zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus) 
    266266                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 
    267267                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 
    268268                  ! 
    269269                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column) 
    270                      zbtr = r1_e12t(iid,jj) / fse3t(iid,jj,jk) 
     270                     zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) 
    271271                     ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 
    272272                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 
    273273                  END DO 
    274274                  ! 
    275                   zbtr = r1_e12t(iid,jj) / fse3t(iid,jj,ikud) 
     275                  zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud) 
    276276                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 
    277277                  pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra 
     
    285285                  ! 
    286286                  ! up  -slope T-point (shelf bottom point) 
    287                   zbtr = r1_e12t(ji,ijs) / fse3t(ji,ijs,ikvs) 
     287                  zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs) 
    288288                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 
    289289                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 
    290290                  ! 
    291291                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column) 
    292                      zbtr = r1_e12t(ji,ijd) / fse3t(ji,ijd,jk) 
     292                     zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk) 
    293293                     ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 
    294294                     pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra 
    295295                  END DO 
    296296                  !                                               ! down-slope T-point (deep bottom point) 
    297                   zbtr = r1_e12t(ji,ijd) / fse3t(ji,ijd,ikvd) 
     297                  zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd) 
    298298                  ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 
    299299                  pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra 
     
    566566 
    567567      !                             !* masked diffusive flux coefficients 
    568       ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:) * umask(:,:,1) 
    569       ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:) * vmask(:,:,1) 
     568      ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 
     569      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 
    570570 
    571571 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r5147 r5737  
    112112            DO jj = 1, jpjm1 
    113113               DO ji = 1, fs_jpim1   ! vector opt. 
    114                   zeeu(ji,jj) = re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) * umask(ji,jj,jk) 
    115                   zeev(ji,jj) = re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) * vmask(ji,jj,jk) 
     114                  zeeu(ji,jj) = e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) * umask(ji,jj,jk) 
     115                  zeev(ji,jj) = e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) * vmask(ji,jj,jk) 
    116116               END DO 
    117117            END DO 
     
    145145            DO jj = 2, jpjm1                 ! Second derivative (divergence) time the eddy diffusivity coefficient 
    146146               DO ji = fs_2, fs_jpim1   ! vector opt. 
    147                   zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     147                  zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    148148                  zlt(ji,jj) = fsahtt(ji,jj,jk) * zbtr * (   ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
    149149                     &                                     + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)   ) 
     
    163163               DO ji = fs_2, fs_jpim1   ! vector opt. 
    164164                  ! horizontal diffusive trends 
    165                   zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     165                  zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    166166                  ztra = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    167167                  ! add it to the general tracer trends 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r5147 r5737  
    210210            DO jj = 1, jpjm1 
    211211               DO ji = 1, jpim1 
    212                   zabe1 = re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    213                   zabe2 = re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     212                  zabe1 = e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
     213                  zabe2 = e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
    214214                   
    215215                  zmku = 1./MAX( tmask(ji+1,jj,jk  )+tmask(ji,jj,jk+1)   & 
     
    279279            DO jk = 2, jpkm1 
    280280               DO ji = 2, jpim1 
    281                   zcof0 = e12t(ji,jj) / fse3w_n(ji,jj,jk)   & 
     281                  zcof0 = e1e2t(ji,jj) / fse3w_n(ji,jj,jk)   & 
    282282                     &     * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)        & 
    283283                     &        + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  ) 
     
    310310                  DO ji = 2, jpim1 
    311311                     ! eddy coef. divided by the volume element 
    312                      zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     312                     zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    313313                     ! vertical divergence 
    314314                     ztav = fsahtt(ji,jj,jk) * ( zftw(ji,jk) - zftw(ji,jk+1) ) 
     
    322322                  DO ji = 2, jpim1 
    323323                     ! inverse of the volume element 
    324                      zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     324                     zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    325325                     ! vertical divergence 
    326326                     ztav = zftw(ji,jk) - zftw(ji,jk+1) 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r5149 r5737  
    200200            DO jj = 1 , jpjm1 
    201201               DO ji = 1, fs_jpim1   ! vector opt. 
    202                   zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    203                   zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     202                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
     203                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
    204204                  ! 
    205205                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   & 
     
    225225            DO jj = 2 , jpjm1 
    226226               DO ji = fs_2, fs_jpim1   ! vector opt. 
    227                   zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     227                  zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    228228                  ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  ) 
    229229                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
     
    313313            DO jj = 2, jpjm1 
    314314               DO ji = fs_2, fs_jpim1   ! vector opt. 
    315                   zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     315                  zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    316316                  ztra = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr 
    317317                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r5147 r5737  
    9696            DO jj = 1, jpjm1 
    9797               DO ji = 1, fs_jpim1   ! vector opt. 
    98                   zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    99                   zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     98                  zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
     99                  zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
    100100                  ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) 
    101101                  ztv(ji,jj,jk) = zabe2 * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
     
    109109                     ikv = mbkv(ji,jj) 
    110110                     IF( iku == jk ) THEN 
    111                         zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku) 
     111                        zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e2_e1u(ji,jj) * fse3u_n(ji,jj,iku) 
    112112                        ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn) 
    113113                     ENDIF 
    114114                     IF( ikv == jk ) THEN 
    115                         zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 
     115                        zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e1_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 
    116116                        ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn) 
    117117                     ENDIF 
     
    128128                     ikv = mikv(ji,jj)  
    129129                     IF( iku == MAX(2,jk) ) THEN  
    130                         zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku)  
     130                        zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e2_e1u(ji,jj) * fse3u_n(ji,jj,iku)  
    131131                        ztu(ji,jj,jk) = zabe1 * pgui(ji,jj,jn)  
    132132                     ENDIF  
    133133                     IF( ikv == MAX(2,jk) ) THEN  
    134                         zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv)  
     134                        zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e1_e2v(ji,jj) * fse3v_n(ji,jj,ikv)  
    135135                        ztv(ji,jj,jk) = zabe2 * pgvi(ji,jj,jn)  
    136136                     END IF  
     
    144144            DO jj = 2, jpjm1 
    145145               DO ji = fs_2, fs_jpim1   ! vector opt. 
    146                   zbtr = 1._wp / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 
     146                  zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    147147                  ! horizontal diffusive trends added to the general tracer trends 
    148148                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90

    r5656 r5737  
    9696         nkstp = kt 
    9797         DO jk = 1, jpkm1 
    98             bu   (:,:,jk) =  e1u(:,:) * e2u(:,:) * fse3u_n(:,:,jk) 
    99             bv   (:,:,jk) =  e1v(:,:) * e2v(:,:) * fse3v_n(:,:,jk) 
     98            bu   (:,:,jk) =           e1e2u(:,:) * fse3u_n(:,:,jk) 
     99            bv   (:,:,jk) =           e1e2v(:,:) * fse3v_n(:,:,jk) 
    100100            r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) ) * tmask(:,:,jk) 
    101101         END DO 
     
    263263      ENDIF 
    264264      !                           ! allocate box volume arrays 
    265       IF ( trd_ken_alloc() /= 0 )   CALL ctl_stop('trd_ken_alloc: failed to allocate arrays') 
     265      IF( trd_ken_alloc() /= 0 )   CALL ctl_stop('trd_ken_alloc: failed to allocate arrays') 
    266266      ! 
    267267!!gm      IF( .NOT. (ln_hpg_zco.OR.ln_hpg_zps) )   & 
    268268!!gm         &   CALL ctl_stop('trd_ken_init : only full and partial cells are coded for conversion rate') 
    269269      ! 
    270       IF ( .NOT.lk_vvl ) THEN     ! constant volume: bu, bv, 1/bt computed one for all 
     270      IF( .NOT.lk_vvl ) THEN      ! constant volume: bu, bv, 1/bt computed one for all 
    271271         DO jk = 1, jpkm1 
    272             bu   (:,:,jk) =  e1u(:,:) * e2u(:,:) * fse3u_n(:,:,jk) 
    273             bv   (:,:,jk) =  e1v(:,:) * e2v(:,:) * fse3v_n(:,:,jk) 
     272            bu   (:,:,jk) =           e1e2u(:,:) * fse3u_n(:,:,jk) 
     273            bv   (:,:,jk) =           e1e2v(:,:) * fse3v_n(:,:,jk) 
    274274            r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) ) 
    275275         END DO 
  • branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r5130 r5737  
    5454#  include "vectopt_loop_substitute.h90" 
    5555   !!---------------------------------------------------------------------- 
    56    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     56   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    5757   !! $Id$ 
    5858   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    136136 
    137137      DO jk = 2, jpkm1     !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s 
    138          DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 
    139             DO ji = 1, jpi 
    140                zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk)  !kz max = 300 cm2/s 
    141             END DO 
    142          END DO 
     138         zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s 
    143139      END DO 
    144140 
    145141      IF( kt == nit000 ) THEN       !* check at first time-step: diagnose the energy consumed by zav_tide 
    146          ztpc = 0.e0 
     142         ztpc = 0._wp 
    147143         DO jk= 1, jpk 
    148144            DO jj= 1, jpj 
    149145               DO ji= 1, jpi 
    150                   ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj)   & 
    151                      &         * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     146                  ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj)                  & 
     147                     &        * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    152148               END DO 
    153149            END DO 
    154150         END DO 
    155151         ztpc= rau0 / ( rn_tfe * rn_me ) * ztpc 
     152         IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    156153         IF(lwp) WRITE(numout,*)  
    157154         IF(lwp) WRITE(numout,*) '          N Total power consumption by av_tide    : ztpc = ', ztpc * 1.e-12 ,'TW' 
     
    167164      !                          ! ----------------------- ! 
    168165      DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing 
    169          DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 
    170             DO ji = 1, jpi 
    171                avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 
    172                avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 
    173             END DO 
    174          END DO 
    175       END DO 
    176        
    177       DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing 
     166         avt(:,:,jk) = avt(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 
     167         avm(:,:,jk) = avm(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 
    178168         DO jj = 2, jpjm1 
    179169            DO ji = fs_2, fs_jpim1  ! vector opt. 
     
    239229      DO jk = 1, jpkm1              
    240230         zdn2dz     (:,:,jk) = rn2(:,:,jk) - rn2(:,:,jk+1)           ! Vertical profile of dN2/dz 
    241 !CDIR NOVERRCHK 
    242231         zempba_3d_1(:,:,jk) = SQRT(  MAX( 0.e0, rn2(:,:,jk) )  )    !    -        -    of N 
    243232         zempba_3d_2(:,:,jk) =        MAX( 0.e0, rn2(:,:,jk) )       !    -        -    of N^2 
     
    248237      zsum2(:,:) = 0.e0 
    249238      DO jk= 2, jpk 
    250          zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * fse3w(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1) 
    251          zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * fse3w(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1)                
     239         zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * fse3w(:,:,jk) * wmask(:,:,jk) 
     240         zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * fse3w(:,:,jk) * wmask(:,:,jk)                
    252241      END DO 
    253242      DO jj = 1, jpj 
     
    285274      zkz(:,:) = 0.e0               ! Associated potential energy consummed over the whole water column 
    286275      DO jk = 2, jpkm1 
    287          zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1) 
     276         zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk) 
    288277      END DO 
    289278 
     
    295284 
    296285      DO jk = 2, jpkm1              ! Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zavt_itf bound by 300 cm2/s 
    297          zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * tmask(:,:,jk) * tmask(:,:,jk-1)   ! kz max = 120 cm2/s 
     286         zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * wmask(:,:,jk)   ! kz max = 120 cm2/s 
    298287      END DO 
    299288 
     
    303292            DO jj= 1, jpj 
    304293               DO ji= 1, jpi 
    305                   ztpc = ztpc + e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) )   & 
    306                      &                     * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     294                  ztpc = ztpc + e1e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) )   & 
     295                     &                       * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    307296               END DO 
    308297            END DO 
    309298         END DO 
     299         IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    310300         ztpc= rau0 * ztpc / ( rn_me * rn_tfe_itf ) 
    311301         IF(lwp) WRITE(numout,*) '          N Total power consumption by zavt_itf: ztpc = ', ztpc * 1.e-12 ,'TW' 
     
    429419!============ 
    430420!TG: Bug for VVL? Should this section be moved out of _init and be updated at every timestep? 
     421!!gm : you are right, but tidal mixing acts in deep ocean (H>500m) where e3 is O(100m) 
     422!!     the error is thus ~1% which I feel comfortable with, compared to uncertainties in tidal energy dissipation. 
    431423      ! Vertical structure (az_tmx) 
    432424      DO jj = 1, jpj                ! part independent of the level 
     
    460452            DO jj = 1, jpj 
    461453               DO ji = 1, jpi 
    462                   ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
     454                  ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
    463455               END DO 
    464456            END DO 
    465457         END DO 
     458         IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    466459         ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 
    467460 
     
    474467         zkz(:,:) = 0.e0 
    475468         DO jk = 2, jpkm1 
    476             DO jj = 1, jpj 
    477                DO ji = 1, jpi 
    478                   zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk) * MAX(0.e0, rn2(ji,jj,jk)) * rau0 * zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 
    479                END DO 
    480             END DO 
     469               zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 
    481470         END DO 
    482471         ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz 
     
    499488 
    500489         DO jk = 2, jpkm1 
    501             DO jj = 1, jpj 
    502                DO ji = 1, jpi 
    503                   zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk)  !kz max = 300 cm2/s 
    504                END DO 
    505             END DO 
     490            zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s 
    506491         END DO 
    507492         ztpc = 0.e0 
     
    510495            DO jj = 1, jpj 
    511496               DO ji = 1, jpi 
    512                   ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
     497                  ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
    513498               END DO 
    514499            END DO 
    515500         END DO 
     501         IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    516502         ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 
    517503         WRITE(numout,*) '          2 Total power consumption of the tidally driven part of Kz : ztpc = ', ztpc * 1.e-12 ,'TW' 
    518  
     504!!gm bug mpp  in these diagnostics 
    519505         DO jk = 1, jpk 
    520             ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zav_tide(:,:,jk)    * tmask_i(:,:) )   & 
    521                &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) ) 
    522             ztpc = 1.E50 
     506            ze_z =                  SUM( e1e2t(:,:) * zav_tide(:,:,jk) * tmask_i(:,:) )   & 
     507               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask  (:,:,jk) * tmask_i(:,:) ) ) 
     508            ztpc = 1.e50 
    523509            DO jj = 1, jpj 
    524510               DO ji = 1, jpi 
    525                   IF( zav_tide(ji,jj,jk) /= 0.e0 )   ztpc =Min( ztpc, zav_tide(ji,jj,jk) ) 
     511                  IF( zav_tide(ji,jj,jk) /= 0.e0 )   ztpc = MIN( ztpc, zav_tide(ji,jj,jk) ) 
    526512               END DO 
    527513            END DO 
     
    530516         END DO 
    531517 
    532          WRITE(numout,*) '          e_tide : ', SUM( e1t*e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW' 
     518         WRITE(numout,*) '          e_tide : ', SUM( e1e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW' 
    533519         WRITE(numout,*)  
    534520         WRITE(numout,*) '          Initial profile of tidal vertical mixing' 
     
    539525               END DO 
    540526            END DO 
    541             ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zkz(:,:)     * tmask_i(:,:) )   & 
    542                &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) ) 
     527            ze_z =                  SUM( e1e2t(:,:) * zkz  (:,:)    * tmask_i(:,:) )   & 
     528               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) ) 
    543529            WRITE(numout,*) '                jk= ', jk,'   ', ze_z * 1.e4,' cm2/s' 
    544530         END DO 
    545531         DO jk = 1, jpk 
    546532            zkz(:,:) = az_tmx(:,:,jk) /rn_n2min 
    547             ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zkz(:,:)     * tmask_i(:,:) )   & 
    548                &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) ) 
     533            ze_z =                  SUM( e1e2t(:,:) * zkz  (:,:)    * tmask_i(:,:) )   & 
     534               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) ) 
    549535            WRITE(numout,*)  
    550536            WRITE(numout,*) '          N2 min - jk= ', jk,'   ', ze_z * 1.e4,' cm2/s min= ',MINVAL(zkz)*1.e4,   & 
    551537               &       'max= ', MAXVAL(zkz)*1.e4, ' cm2/s' 
    552538         END DO 
     539!!gm  end bug mpp 
    553540         ! 
    554541      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.