Changeset 5836 for trunk/NEMOGCM/NEMO


Ignore:
Timestamp:
2015-10-26T15:49:40+01:00 (5 years ago)
Author:
cetlod
Message:

merge the simplification branch onto the trunk, see ticket #1612

Location:
trunk/NEMOGCM/NEMO
Files:
31 deleted
178 edited
8 copied

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90

    r4624 r5836  
    7171         CALL fld_read( kt, nn_fsbc, sf_icedmp ) 
    7272         ! 
    73 !CDIR COLLAPSE 
    7473         hicif(:,:) = MAX( 0._wp,                     &        ! h >= 0         avoid spurious out of physical range 
    7574            &         hicif(:,:) - rdt_ice * resto_ice(:,:,1) * ( hicif(:,:) - sf_icedmp(jp_hicif)%fnow(:,:,1) )  )  
    76 !CDIR COLLAPSE 
    7775         frld (:,:) = MAX( 0._wp, MIN( 1._wp,         &        ! 0<= frld<=1    values which blow the run up 
    7876            &         frld (:,:) - rdt_ice * resto_ice(:,:,1) * ( frld (:,:) - sf_icedmp(jp_frld )%fnow(:,:,1) )  )  ) 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90

    r5123 r5836  
    160160      !------------------------------------------------------------------- 
    161161 
    162 !CDIR NOVERRCHK 
    163162      DO jj = k_j1 , k_jpj-1 
    164 !CDIR NOVERRCHK 
    165163         DO ji = 1 , jpi 
    166164            ! only the sinus changes its sign with the hemisphere 
    … …  
    245243         ! Computation of free drift field for free slip boundary conditions. 
    246244 
    247 !CDIR NOVERRCHK 
    248245         DO jj = k_j1, k_jpj-1 
    249 !CDIR NOVERRCHK 
    250246            DO ji = 1, fs_jpim1 
    251247               !- Rate of strain tensor. 
    … …  
    401397iflag:   DO jter = 1 , nbitdr                                   !    Relaxation    ! 
    402398            !                                                   ! ================ ! 
    403 !CDIR NOVERRCHK 
    404399            DO jj = k_j1+1, k_jpj-1 
    405 !CDIR NOVERRCHK 
    406400               DO ji = 2, fs_jpim1   ! NO vector opt. 
    407401                  ! 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r5407 r5836  
    319319         ! 
    320320         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==! (i.e. surface module time-step) 
    321 !CDIR NOVERRCHK 
     321            ! 
    322322            DO jj = 1, jpj                               !* modulus of ice-ocean relative velocity at I-point 
    323 !CDIR NOVERRCHK 
    324323               DO ji = 1, jpi 
    325324                  zu_i  = u_ice(ji,jj) - u_oce(ji,jj)                   ! ice-ocean relative velocity at I-point 
    … …  
    328327               END DO 
    329328            END DO 
    330 !CDIR NOVERRCHK 
    331329            DO jj = 1, jpjm1                             !* update the modulus of stress at ocean surface (T-point) 
    332 !CDIR NOVERRCHK 
    333330               DO ji = 1, jpim1   ! NO vector opt. 
    334331                  !                                               ! modulus of U_ice-U_oce at T-point 
    … …  
    383380         ! 
    384381         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==! (i.e. surface module time-step) 
    385 !CDIR NOVERRCHK 
     382            ! 
    386383            DO jj = 2, jpjm1                          !* modulus of the ice-ocean velocity at T-point 
    387 !CDIR NOVERRCHK 
    388384               DO ji = fs_2, fs_jpim1 
    389385                  zu_t  = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   ! 2*(U_ice-U_oce) at T-point 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r5407 r5836  
    196196      !-------------------------------------------------------------------------- 
    197197 
    198       !CDIR NOVERRCHK 
    199198      DO jj = 1, jpj 
    200          !CDIR NOVERRCHK 
    201199         DO ji = 1, jpi 
    202200            zthsnice       = hsnif(ji,jj) + hicif(ji,jj) 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90

    r3625 r5836  
    134134      !--------------------------------------------------------------------- 
    135135       
    136 !CDIR NOVERRCHK 
    137136      DO ji = kideb , kiut 
    138137         iicefr       = 1 - MAX( 0, INT( SIGN( 1.5 * zone , zfrl_old(ji) - 1.0 + epsi13 ) ) ) 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r5429 r5836  
    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               

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r5183 r5836  
    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 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90

    r5167 r5836  
    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)        

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r5215 r5836  
    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 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r5123 r5836  
    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      :') 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r5429 r5836  
    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 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r5202 r5836  
    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      :') 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r5429 r5836  
    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 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r5407 r5836  
    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      :') 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r5202 r5836  
    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 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    r5215 r5836  
    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        :') 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    r5410 r5836  
    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        :') 

  • trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r5656 r5836  
    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) & 

  • trunk/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

    r5656 r5836  
    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)  ) 

  • trunk/NEMOGCM/NEMO/OFF_SRC/domrea.F90

    r5504 r5836  
    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  
    74       CALL dom_nam      ! read namelist ( namrun, namdom, namcla ) 
     66      ! 
     67      CALL dom_nam      ! read namelist ( namrun, namdom ) 
    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 
    … …  
    115109      !! ** input   : - namrun namelist 
    116110      !!              - namdom namelist 
    117       !!              - namcla namelist 
    118111      !!---------------------------------------------------------------------- 
    119112      USE ioipsl 
    120       INTEGER  ::   ios                 ! Local integer output status for namelist read 
     113      INTEGER  ::   ios   ! Local integer output status for namelist read 
     114      ! 
    121115      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               & 
    122116         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
    … …  
    130124         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 
    131125         &             ppa2, ppkth2, ppacr2 
    132       NAMELIST/namcla/ nn_cla 
    133126#if defined key_netcdf4 
    134127      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 
    … …  
    178171      nstocklist = nn_stocklist 
    179172      nwrite = nn_write 
    180  
    181  
     173      ! 
    182174      !                             ! control of output frequency 
    183175      IF ( nstock == 0 .OR. nstock > nitend ) THEN 
    … …  
    275267      rdth      = rn_rdth 
    276268 
    277       REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection 
    278       READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905) 
    279 905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp ) 
    280  
    281       REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection 
    282       READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 ) 
    283 906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp ) 
    284       IF(lwm) WRITE( numond, namcla ) 
    285  
    286       IF(lwp) THEN 
    287          WRITE(numout,*) 
    288          WRITE(numout,*) '   Namelist namcla' 
    289          WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla 
    290       ENDIF 
    291  
    292269#if defined key_netcdf4 
    293270      !                             ! NetCDF 4 case   ("key_netcdf4" defined) 
    … …  
    321298   END SUBROUTINE dom_nam 
    322299 
     300 
    323301   SUBROUTINE dom_zgr 
    324302      !!---------------------------------------------------------------------- 
    … …  
    374352   END SUBROUTINE dom_zgr 
    375353 
     354 
    376355   SUBROUTINE dom_ctl 
    377356      !!---------------------------------------------------------------------- 
    … …  
    382361      !! ** Method  :   compute and print extrema of masked scale factors 
    383362      !! 
    384       !! History : 
    385       !!   8.5  !  02-08  (G. Madec)    Original code 
    386       !!---------------------------------------------------------------------- 
    387       !! * Local declarations 
     363      !!---------------------------------------------------------------------- 
    388364      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 
    389365      INTEGER, DIMENSION(2) ::   iloc      !  
    … …  
    421397         ijma2 = iloc(2) + njmpp - 1 
    422398      ENDIF 
    423  
     399      ! 
    424400      IF(lwp) THEN 
    425401         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1 
    … …  
    428404         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2 
    429405      ENDIF 
    430  
     406      ! 
    431407   END SUBROUTINE dom_ctl 
     408 
    432409 
    433410   SUBROUTINE dom_grd 
    … …  
    538515         CALL iom_get( inum2, jpdom_data, 'facvolt', facvol ) 
    539516#endif 
    540  
    541517         !                                                         ! horizontal mesh (inum3) 
    542518         CALL iom_get( inum3, jpdom_data, 'glamt', glamt ) 
    … …  
    756732      !!                                     (min value = 1 over land) 
    757733      !!---------------------------------------------------------------------- 
    758       ! 
    759734      INTEGER ::   ji, jj   ! dummy loop indices 
    760735      REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 
    … …  
    785760   END SUBROUTINE zgr_bot_level 
    786761 
     762 
    787763   SUBROUTINE dom_msk 
    788764      !!--------------------------------------------------------------------- 
    … …  
    799775      !!               tpol     : ??? 
    800776      !!---------------------------------------------------------------------- 
    801       ! 
    802       INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
    803       INTEGER  ::   iif, iil, ijf, ijl       ! local integers 
     777      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
     778      INTEGER  ::   iif, iil, ijf, ijl   ! local integers 
    804779      INTEGER, POINTER, DIMENSION(:,:) ::  imsk  
    805       ! 
    806780      !!--------------------------------------------------------------------- 
    807781       
    … …  
    853827      ! 3. Ocean/land mask at wu-, wv- and w points  
    854828      !---------------------------------------------- 
    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) 
     829      wmask (:,:,1) = tmask(:,:,1)        ! surface value 
     830      wumask(:,:,1) = umask(:,:,1)  
     831      wvmask(:,:,1) = vmask(:,:,1) 
     832      DO jk = 2, jpk                      ! deeper value 
     833         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 
     834         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)    
     835         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 
    862836      END DO 
    863837      ! 

  • trunk/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r5768 r5836  
    2626   USE trc_oce         ! share ocean/biogeo variables 
    2727   USE phycst          ! physical constants 
     28   USE ldftra          ! lateral diffusivity coefficients 
    2829   USE trabbl          ! active tracer: bottom boundary layer 
    2930   USE ldfslp          ! lateral diffusion: iso-neutral slopes 
    30    USE ldfeiv          ! eddy induced velocity coef.  
    31    USE ldftra_oce      ! ocean tracer   lateral physics 
    3231   USE zdfmxl          ! vertical physics: mixed layer depth 
    3332   USE eosbn2          ! equation of state - Brunt Vaisala frequency 
    … …  
    4039   USE fldread         ! read input fields  
    4140   USE timing          ! Timing 
     41   USE wrk_nemo 
    4242 
    4343   IMPLICIT NONE 
    … …  
    5050   LOGICAL            ::   ln_dynwzv    !: vertical velocity read in a file (T) or computed from u/v (F) 
    5151   LOGICAL            ::   ln_dynbbl    !: bbl coef read in a file (T) or computed (F) 
    52    LOGICAL            ::   ln_degrad    !: degradation option enabled or not 
    5352   LOGICAL            ::   ln_dynrnf    !: read runoff data in file (T) or set to zero (F) 
    5453 
    55    INTEGER  , PARAMETER ::   jpfld = 21     ! maximum number of fields to read 
     54   INTEGER  , PARAMETER ::   jpfld = 15     ! maximum number of fields to read 
    5655   INTEGER  , SAVE      ::   jf_tem         ! index of temperature 
    5756   INTEGER  , SAVE      ::   jf_sal         ! index of salinity 
    … …  
    6867   INTEGER  , SAVE      ::   jf_ubl         ! index of u-bbl coef 
    6968   INTEGER  , SAVE      ::   jf_vbl         ! index of v-bbl coef 
    70    INTEGER  , SAVE      ::   jf_ahu         ! index of u-diffusivity coef 
    71    INTEGER  , SAVE      ::   jf_ahv         ! index of v-diffusivity coef  
    72    INTEGER  , SAVE      ::   jf_ahw         ! index of w-diffusivity coef 
    73    INTEGER  , SAVE      ::   jf_eiu         ! index of u-eiv 
    74    INTEGER  , SAVE      ::   jf_eiv         ! index of v-eiv 
    75    INTEGER  , SAVE      ::   jf_eiw         ! index of w-eiv 
    7669   INTEGER  , SAVE      ::   jf_fmf         ! index of downward salt flux 
    7770 
    … …  
    112105      !!             - interpolates data if needed 
    113106      !!---------------------------------------------------------------------- 
    114       ! 
    115       USE oce, ONLY:  zts    => tsa  
     107      USE oce, ONLY:  zts    => tsa 
    116108      USE oce, ONLY:  zuslp  => ua   , zvslp  => va 
    117       USE oce, ONLY:  zwslpi => rotb , zwslpj => rotn 
    118       USE oce, ONLY:  zu     => ub   , zv     => vb,  zw => hdivb 
     109      USE oce, ONLY:  zwslpi => ua_sv , zwslpj => va_sv 
     110      USE oce, ONLY:  zu     => ub   , zv     => vb,  zw => rke 
    119111      ! 
    120112      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     113      ! 
     114!      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)  :: zts 
     115!      REAL(wp), DIMENSION(jpi,jpj,jpk     )  :: zuslp, zvslp, zwslpi, zwslpj 
     116!      REAL(wp), DIMENSION(jpi,jpj,jpk     )  :: zu, zv, zw 
     117      ! 
    121118      ! 
    122119      INTEGER  ::   ji, jj     ! dummy loop indices 
    … …  
    138135         CALL fld_read( kt, 1, sf_dyn )      !==   read data at kt time step   ==! 
    139136         ! 
    140          IF( lk_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                        
     137         IF( l_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                        
    141138            zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:)   ! temperature 
    142139            zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:)   ! salinity  
    … …  
    162159      ENDIF 
    163160      !  
    164       IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)                        
     161      IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)                        
    165162         iswap_tem = 0 
    166163         IF(  kt /= nit000 .AND. ( sf_dyn(jf_tem)%nrec_a(2) - nrecprev_tem ) /= 0 )  iswap_tem = 1 
    … …  
    267264      rnf (:,:)        = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1)    ! river runoffs  
    268265 
     266      !                                               ! update eddy diffusivity coeff. and/or eiv coeff. at kt 
     267      IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kt )  
    269268      !                                                      ! bbl diffusive coef 
    270269#if defined key_trabbl && ! defined key_c1d 
    … …  
    276275         CALL bbl( kt, nit000, 'TRC') 
    277276      END IF 
    278 #endif 
    279 #if ( ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv ) && ! defined key_c1d  
    280       aeiw(:,:)        = sf_dyn(jf_eiw)%fnow(:,:,1) * tmask(:,:,1)    ! w-eiv 
    281       !                                                           ! Computes the horizontal values from the vertical value 
    282       DO jj = 2, jpjm1 
    283          DO ji = fs_2, fs_jpim1   ! vector opt. 
    284             aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) )  ! Average the diffusive coefficient at u- v- points 
    285             aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) )  ! at u- v- points 
    286          END DO 
    287       END DO 
    288       CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )    ! lateral boundary condition 
    289 #endif 
    290        
    291 #if defined key_degrad && ! defined key_c1d  
    292       !                                          ! degrad option : diffusive and eiv coef are 3D 
    293       ahtu(:,:,:) = sf_dyn(jf_ahu)%fnow(:,:,:) * umask(:,:,:) 
    294       ahtv(:,:,:) = sf_dyn(jf_ahv)%fnow(:,:,:) * vmask(:,:,:) 
    295       ahtw(:,:,:) = sf_dyn(jf_ahw)%fnow(:,:,:) * tmask(:,:,:) 
    296 #  if defined key_traldf_eiv  
    297       aeiu(:,:,:) = sf_dyn(jf_eiu)%fnow(:,:,:) * umask(:,:,:) 
    298       aeiv(:,:,:) = sf_dyn(jf_eiv)%fnow(:,:,:) * vmask(:,:,:) 
    299       aeiw(:,:,:) = sf_dyn(jf_eiw)%fnow(:,:,:) * tmask(:,:,:) 
    300 #  endif 
    301277#endif 
    302278      ! 
    … …  
    339315      TYPE(FLD_N), DIMENSION(jpfld) ::  slf_d    ! array of namelist informations on the fields to read 
    340316      TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf  ! informations about the fields to be read 
    341       TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl          !   "                                 " 
    342       TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf  !   "                                 " 
    343       !!---------------------------------------------------------------------- 
    344       ! 
    345       NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad, ln_dynrnf,    & 
     317      TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, sn_fmf          !   "                                 " 
     318      NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_dynrnf,    & 
    346319         &                sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf,  & 
    347          &                sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl,          & 
    348          &                sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf 
     320         &                sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, sn_fmf   
     321      !!---------------------------------------------------------------------- 
    349322      ! 
    350323      REWIND( numnam_ref )              ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data 
    … …  
    365338         WRITE(numout,*) '      vertical velocity read from file (T) or computed (F) ln_dynwzv  = ', ln_dynwzv 
    366339         WRITE(numout,*) '      bbl coef read from file (T) or computed (F)          ln_dynbbl  = ', ln_dynbbl 
    367          WRITE(numout,*) '      degradation option enabled (T) or not (F)            ln_degrad  = ', ln_degrad 
    368340         WRITE(numout,*) '      river runoff option enabled (T) or not (F)           ln_dynrnf  = ', ln_dynrnf 
    369341         WRITE(numout,*) 
    370342      ENDIF 
    371343      !  
    372       IF( ln_degrad .AND. .NOT.lk_degrad ) THEN 
    373          CALL ctl_warn( 'dta_dyn_init: degradation option requires key_degrad activated ; force ln_degrad to false' ) 
    374          ln_degrad = .FALSE. 
    375       ENDIF 
    376344      IF( ln_dynbbl .AND. ( .NOT.lk_trabbl .OR. lk_c1d ) ) THEN 
    377345         CALL ctl_warn( 'dta_dyn_init: bbl option requires key_trabbl activated ; force ln_dynbbl to false' ) 
    … …  
    395363      ENDIF 
    396364 
    397       ! 
    398       IF( .NOT.ln_degrad ) THEN     ! no degrad option 
    399          IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN        ! eiv & bbl 
    400                  jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;        jf_eiw  = jfld + 3   ;   jfld = jf_eiw 
    401            slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl  ;   slf_d(jf_eiw) = sn_eiw 
    402          ENDIF 
    403          IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN   ! no eiv & bbl 
     365      IF( ln_dynbbl ) THEN         ! eiv & bbl 
    404366                 jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;  jfld = jf_vbl 
    405367           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl 
    406          ENDIF 
    407          IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN   ! eiv & no bbl 
    408            jf_eiw = jfld + 1 ; jfld = jf_eiw ; slf_d(jf_eiw) = sn_eiw 
    409          ENDIF 
    410       ELSE 
    411               jf_ahu  = jfld + 1 ;        jf_ahv  = jfld + 2 ;        jf_ahw  = jfld + 3  ;  jfld = jf_ahw 
    412         slf_d(jf_ahu) = sn_ahu  ;   slf_d(jf_ahv) = sn_ahv  ;   slf_d(jf_ahw) = sn_ahw 
    413         IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN         ! eiv & bbl 
    414                  jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ; 
    415            slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl 
    416                  jf_eiu  = jfld + 3 ;        jf_eiv  = jfld + 4 ;    jf_eiw  = jfld + 5   ;  jfld = jf_eiw  
    417            slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;    slf_d(jf_eiw) = sn_eiw 
    418         ENDIF 
    419         IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN    ! no eiv & bbl 
    420                  jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;  jfld = jf_vbl 
    421            slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl 
    422         ENDIF 
    423         IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN    ! eiv & no bbl 
    424                  jf_eiu  = jfld + 1 ;         jf_eiv  = jfld + 2 ;    jf_eiw  = jfld + 3   ; jfld = jf_eiw  
    425            slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;   slf_d(jf_eiw) = sn_eiw 
    426         ENDIF 
    427       ENDIF 
    428    
     368      ENDIF 
     369 
     370 
    429371      ALLOCATE( sf_dyn(jfld), STAT=ierr )         ! set sf structure 
    430372      IF( ierr > 0 ) THEN 
    … …  
    452394      END DO 
    453395      ! 
    454       IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN                  ! slopes  
     396      IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN                  ! slopes  
    455397         IF( sf_dyn(jf_tem)%ln_tint ) THEN      ! time interpolation 
    456398            ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    & 
    … …  
    511453               zv  = pv(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) 
    512454               zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) 
    513                zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     455               zet = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    514456               zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet  
    515457            END DO 
    516458         END DO 
    517459      END DO 
     460      !                              !  update the horizontal divergence with the runoff inflow 
     461      IF( ln_dynrnf )  zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / fse3t(:,:,1) 
     462      ! 
    518463      CALL lbc_lnk( zhdiv, 'T', 1. )      ! Lateral boundary conditions on zhdiv 
    519       ! 
    520464      ! computation of vertical velocity from the bottom 
    521465      pw(:,:,jpk) = 0._wp 
    … …  
    540484      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pwslpj   ! meridional diapycnal slopes 
    541485      !!--------------------------------------------------------------------- 
    542 #if defined key_ldfslp && ! defined key_c1d 
    543       CALL eos    ( pts, rhd, rhop, gdept_0(:,:,:) ) 
    544       CALL eos_rab( pts, rab_n )       ! now local thermal/haline expension ratio at T-points 
    545       CALL bn2    ( pts, rab_n, rn2  ) ! now    Brunt-Vaisala 
    546  
    547       ! Partial steps: before Horizontal DErivative 
    548       IF( ln_zps  .AND. .NOT. ln_isfcav)                            & 
    549          &            CALL zps_hde    ( kt, jpts, pts, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient 
    550          &                                        rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
    551       IF( ln_zps .AND.        ln_isfcav)                            & 
    552          &            CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv,  &    ! Partial steps for top cell (ISF) 
    553          &                                        rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
    554          &                                 gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the first ocean level 
    555  
    556       rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl 
    557       CALL zdf_mxl( kt )            ! mixed layer depth 
    558       CALL ldf_slp( kt, rhd, rn2 )  ! slopes 
    559       puslp (:,:,:) = uslp (:,:,:)  
    560       pvslp (:,:,:) = vslp (:,:,:)  
    561       pwslpi(:,:,:) = wslpi(:,:,:)  
    562       pwslpj(:,:,:) = wslpj(:,:,:)  
    563 #else 
    564       puslp (:,:,:) = 0.            ! to avoid warning when compiling 
    565       pvslp (:,:,:) = 0. 
    566       pwslpi(:,:,:) = 0. 
    567       pwslpj(:,:,:) = 0. 
    568 #endif 
     486      IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)                        
     487         CALL eos    ( pts, rhd, rhop, gdept_0(:,:,:) ) 
     488         CALL eos_rab( pts, rab_n )       ! now local thermal/haline expension ratio at T-points 
     489         CALL bn2    ( pts, rab_n, rn2  ) ! now    Brunt-Vaisala 
     490 
     491         ! Partial steps: before Horizontal DErivative 
     492         IF( ln_zps  .AND. .NOT. ln_isfcav)                            & 
     493            &            CALL zps_hde    ( kt, jpts, pts, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient 
     494            &                                        rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
     495         IF( ln_zps .AND.        ln_isfcav)                            & 
     496            &            CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv,  &    ! Partial steps for top cell (ISF) 
     497            &                                        rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
     498            &                                 gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the first ocean level 
     499 
     500         rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl 
     501         CALL zdf_mxl( kt )            ! mixed layer depth 
     502         CALL ldf_slp( kt, rhd, rn2 )  ! slopes 
     503         puslp (:,:,:) = uslp (:,:,:)  
     504         pvslp (:,:,:) = vslp (:,:,:)  
     505         pwslpi(:,:,:) = wslpi(:,:,:)  
     506         pwslpj(:,:,:) = wslpj(:,:,:)  
     507     ELSE 
     508         puslp (:,:,:) = 0.            ! to avoid warning when compiling 
     509         pvslp (:,:,:) = 0. 
     510         pwslpi(:,:,:) = 0. 
     511         pwslpj(:,:,:) = 0. 
     512     ENDIF 
    569513      ! 
    570514   END SUBROUTINE dta_dyn_slp 

  • trunk/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r5504 r5836  
    2626   USE traqsr          ! solar radiation penetration    (tra_qsr_init routine) 
    2727   USE trabbl          ! bottom boundary layer          (tra_bbl_init routine) 
     28   USE traldf          ! lateral physics                (tra_ldf_init routine) 
    2829   USE zdfini          ! vertical physics: initialization 
    2930   USE sbcmod          ! surface boundary condition       (sbc_init     routine) 
    … …  
    283284                            CALL     sbc_init   ! Forcings : surface module 
    284285 
    285 #if ! defined key_degrad 
    286286                            CALL ldf_tra_init   ! Lateral ocean tracer physics 
    287 #endif 
    288       IF( lk_ldfslp )       CALL ldf_slp_init   ! slope of lateral mixing 
     287                            CALL ldf_eiv_init   ! Eddy induced velocity param 
     288                            CALL tra_ldf_init   ! lateral mixing 
     289      IF( l_ldfslp )        CALL ldf_slp_init   ! slope of lateral mixing 
    289290 
    290291                            CALL tra_qsr_init   ! penetrative solar radiation qsr 
    … …  
    444445      USE dom_oce,      ONLY: dom_oce_alloc 
    445446      USE zdf_oce,      ONLY: zdf_oce_alloc 
    446       USE ldftra_oce,   ONLY: ldftra_oce_alloc 
    447447      USE trc_oce,      ONLY: trc_oce_alloc 
    448448      ! 
    … …  
    453453      ierr = ierr + dia_wri_alloc   () 
    454454      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
    455       ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers 
    456455      ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics 
    457456      ! 

  • trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90

    r5215 r5836  
    1818 
    1919   !!---------------------------------------------------------------------- 
    20    !!   'key_asminc' : Switch on the assimilation increment interface 
    21    !!---------------------------------------------------------------------- 
    2220   !!   asm_bkg_wri  : Write out the background state 
    2321   !!   asm_trj_wri  : Write out the model state trajectory (used with 4D-Var) 
    … …  
    2725   USE zdf_oce            ! Vertical mixing variables 
    2826   USE zdfddm             ! Double diffusion mixing parameterization 
    29    USE ldftra_oce         ! Lateral tracer mixing coefficient defined in memory 
    30    USE ldfslp             ! Slopes of neutral surfaces 
     27   USE ldftra             ! Lateral diffusion: eddy diffusivity coefficients 
     28   USE ldfslp             ! Lateral diffusion: slopes of neutral surfaces 
    3129   USE tradmp             ! Tracer damping 
    3230#if defined key_zdftke 
    … …  
    4139   USE asmpar             ! Parameters for the assmilation interface 
    4240   USE zdfmxl             ! mixed layer depth 
    43 #if defined key_traldf_c2d 
    44    USE ldfeiv             ! eddy induced velocity coef.      (ldf_eiv routine) 
    45 #endif 
    4641#if defined key_lim2 
    4742   USE ice_2 
    … …  
    155150            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              ) 
    156151#if defined key_lim2 || defined key_lim3 
    157             IF(( nn_ice == 2 ) .OR. ( nn_ice == 3 )) THEN 
    158           IF(ALLOCATED(frld)) THEN 
    159                   CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1.0 - frld(:,:)   ) 
     152            IF( nn_ice == 2  .OR.  nn_ice == 3 ) THEN 
     153               IF( ALLOCATED(frld) ) THEN 
     154                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1._wp - frld(:,:)   ) 
    160155               ELSE 
    161         CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep') 
    162           ENDIF 
     156                  CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep') 
     157               ENDIF 
    163158            ENDIF 
    164159#endif 

  • trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r5541 r5836  
    1414 
    1515   !!---------------------------------------------------------------------- 
    16    !!   'key_asminc'   : Switch on the assimilation increment interface 
    17    !!---------------------------------------------------------------------- 
    1816   !!   asm_inc_init   : Initialize the increment arrays and IAU weights 
    1917   !!   calc_date      : Compute the calendar date YYYYMMDD on a given step 
    … …  
    2826   USE domvvl           ! domain: variable volume level 
    2927   USE oce              ! Dynamics and active tracers defined in memory 
    30    USE ldfdyn_oce       ! ocean dynamics: lateral physics 
     28   USE ldfdyn           ! lateral diffusion: eddy viscosity coefficients 
    3129   USE eosbn2           ! Equation of state - in situ and potential density 
    3230   USE zpshde           ! Partial step : Horizontal Derivative 
    … …  
    5654    LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .FALSE.  !: No assimilation increments 
    5755#endif 
    58    LOGICAL, PUBLIC :: ln_bkgwri = .FALSE.      !: No output of the background state fields 
    59    LOGICAL, PUBLIC :: ln_asmiau = .FALSE.      !: No applying forcing with an assimilation increment 
    60    LOGICAL, PUBLIC :: ln_asmdin = .FALSE.      !: No direct initialization 
    61    LOGICAL, PUBLIC :: ln_trainc = .FALSE.      !: No tracer (T and S) assimilation increments 
    62    LOGICAL, PUBLIC :: ln_dyninc = .FALSE.      !: No dynamics (u and v) assimilation increments 
    63    LOGICAL, PUBLIC :: ln_sshinc = .FALSE.      !: No sea surface height assimilation increment 
    64    LOGICAL, PUBLIC :: ln_seaiceinc             !: No sea ice concentration increment 
    65    LOGICAL, PUBLIC :: ln_salfix = .FALSE.      !: Apply minimum salinity check 
     56   LOGICAL, PUBLIC :: ln_bkgwri     !: No output of the background state fields 
     57   LOGICAL, PUBLIC :: ln_asmiau     !: No applying forcing with an assimilation increment 
     58   LOGICAL, PUBLIC :: ln_asmdin     !: No direct initialization 
     59   LOGICAL, PUBLIC :: ln_trainc     !: No tracer (T and S) assimilation increments 
     60   LOGICAL, PUBLIC :: ln_dyninc     !: No dynamics (u and v) assimilation increments 
     61   LOGICAL, PUBLIC :: ln_sshinc     !: No sea surface height assimilation increment 
     62   LOGICAL, PUBLIC :: ln_seaiceinc  !: No sea ice concentration increment 
     63   LOGICAL, PUBLIC :: ln_salfix     !: Apply minimum salinity check 
    6664   LOGICAL, PUBLIC :: ln_temnofreeze = .FALSE. !: Don't allow the temperature to drop below freezing 
    67    INTEGER, PUBLIC :: nn_divdmp                !: Apply divergence damping filter nn_divdmp times 
     65   INTEGER, PUBLIC :: nn_divdmp     !: Apply divergence damping filter nn_divdmp times 
    6866 
    6967   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   t_bkg   , s_bkg      !: Background temperature and salinity 
    … …  
    9088   !! * Substitutions 
    9189#  include "domzgr_substitute.h90" 
    92 #  include "ldfdyn_substitute.h90" 
    9390#  include "vectopt_loop_substitute.h90" 
    9491   !!---------------------------------------------------------------------- 
    … …  
    139136      ! Read Namelist nam_asminc : assimilation increment interface 
    140137      !----------------------------------------------------------------------- 
    141       ln_seaiceinc = .FALSE. 
     138      ln_seaiceinc   = .FALSE. 
    142139      ln_temnofreeze = .FALSE. 
    143140 
    … …  
    428425 
    429426      IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN 
    430  
    431          CALL wrk_alloc(jpi,jpj,hdiv)  
    432  
    433          DO  jt = 1, nn_divdmp 
    434  
     427         ! 
     428         CALL wrk_alloc( jpi,jpj,   hdiv )  
     429         ! 
     430         DO jt = 1, nn_divdmp 
     431            ! 
    435432            DO jk = 1, jpkm1 
    436  
    437433               hdiv(:,:) = 0._wp 
    438  
    439434               DO jj = 2, jpjm1 
    440435                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    444439                         + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * v_bkginc(ji  ,jj  ,jk)     & 
    445440                         - 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) ) 
     441                         / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    447442                  END DO 
    448443               END DO 
    449  
    450444               CALL lbc_lnk( hdiv, 'T', 1. )   ! lateral boundary cond. (no sign change) 
    451  
     445               ! 
    452446               DO jj = 2, jpjm1 
    453447                  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)  
     448                     u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji+1,jj) * hdiv(ji+1,jj)   & 
     449                        &                                               - e1e2t(ji  ,jj) * hdiv(ji  ,jj) ) & 
     450                        &                                             * r1_e1u(ji,jj) * umask(ji,jj,jk)  
     451                     v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji,jj+1) * hdiv(ji,jj+1)   & 
     452                        &                                               - e1e2t(ji,jj  ) * hdiv(ji,jj  ) ) & 
     453                        &                                             * r1_e2v(ji,jj) * vmask(ji,jj,jk)  
    460454                  END DO 
    461455               END DO 
    462  
    463456            END DO 
    464  
     457            ! 
    465458         END DO 
    466  
    467          CALL wrk_dealloc(jpi,jpj,hdiv)  
    468  
     459         ! 
     460         CALL wrk_dealloc( jpi,jpj,   hdiv )  
     461         ! 
    469462      ENDIF 
    470  
    471  
    472463 
    473464      !----------------------------------------------------------------------- 
    … …  
    476467 
    477468      IF ( ln_asmdin ) THEN 
    478  
     469         ! 
    479470         ALLOCATE( t_bkg(jpi,jpj,jpk) ) 
    480471         ALLOCATE( s_bkg(jpi,jpj,jpk) ) 
    … …  
    482473         ALLOCATE( v_bkg(jpi,jpj,jpk) ) 
    483474         ALLOCATE( ssh_bkg(jpi,jpj)   ) 
    484  
    485          t_bkg(:,:,:) = 0.0 
    486          s_bkg(:,:,:) = 0.0 
    487          u_bkg(:,:,:) = 0.0 
    488          v_bkg(:,:,:) = 0.0 
    489          ssh_bkg(:,:) = 0.0 
    490  
     475         ! 
     476         t_bkg(:,:,:) = 0._wp 
     477         s_bkg(:,:,:) = 0._wp 
     478         u_bkg(:,:,:) = 0._wp 
     479         v_bkg(:,:,:) = 0._wp 
     480         ssh_bkg(:,:) = 0._wp 
     481         ! 
    491482         !-------------------------------------------------------------------- 
    492483         ! Read from file the background state at analysis time 
    493484         !-------------------------------------------------------------------- 
    494  
     485         ! 
    495486         CALL iom_open( c_asmdin, inum ) 
    496  
     487         ! 
    497488         CALL iom_get( inum, 'rdastp', zdate_bkg )  
    498          
     489         ! 
    499490         IF(lwp) THEN 
    500491            WRITE(numout,*)  
    501             WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', & 
    502                &  NINT( zdate_bkg ) 
     492            WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', NINT( zdate_bkg ) 
    503493            WRITE(numout,*) '~~~~~~~~~~~~' 
    504494         ENDIF 
    505  
     495         ! 
    506496         IF ( NINT( zdate_bkg ) /= iitdin_date ) & 
    507497            & CALL ctl_warn( ' Validity time of assimilation background state does', & 
    508498            &                ' not agree with Direct Initialization time' ) 
    509  
     499         ! 
    510500         IF ( ln_trainc ) THEN    
    511501            CALL iom_get( inum, jpdom_autoglo, 'tn', t_bkg ) 
    … …  
    514504            s_bkg(:,:,:) = s_bkg(:,:,:) * tmask(:,:,:) 
    515505         ENDIF 
    516  
     506         ! 
    517507         IF ( ln_dyninc ) THEN    
    518508            CALL iom_get( inum, jpdom_autoglo, 'un', u_bkg ) 
    … …  
    521511            v_bkg(:,:,:) = v_bkg(:,:,:) * vmask(:,:,:) 
    522512         ENDIF 
    523          
     513         ! 
    524514         IF ( ln_sshinc ) THEN 
    525515            CALL iom_get( inum, jpdom_autoglo, 'sshn', ssh_bkg ) 
    526516            ssh_bkg(:,:) = ssh_bkg(:,:) * tmask(:,:,1) 
    527517         ENDIF 
    528  
     518         ! 
    529519         CALL iom_close( inum ) 
    530  
     520         ! 
    531521      ENDIF 
    532522      ! 
    … …  
    574564      ! If kt = kit000 - 1 then set the date to the restart date 
    575565      IF ( kt == kit000 - 1 ) THEN 
    576  
    577566         kdate = ndastp 
    578567         RETURN 
    579  
    580568      ENDIF 
    581569 
    … …  
    646634      !! ** Action  :  
    647635      !!---------------------------------------------------------------------- 
    648       INTEGER, INTENT(IN) :: kt               ! Current time step 
    649       ! 
    650       INTEGER :: ji,jj,jk 
    651       INTEGER :: it 
     636      INTEGER, INTENT(IN) ::   kt   ! Current time step 
     637      ! 
     638      INTEGER  :: ji, jj, jk 
     639      INTEGER  :: it 
    652640      REAL(wp) :: zincwgt  ! IAU weight for current time step 
    653641      REAL (wp), DIMENSION(jpi,jpj,jpk) :: fzptnz ! 3d freezing point values 
    654642      !!---------------------------------------------------------------------- 
    655  
     643      ! 
    656644      ! freezing point calculation taken from oc_fz_pt (but calculated for all depths)  
    657645      ! used to prevent the applied increments taking the temperature below the local freezing point  
    658  
    659646      DO jk = 1, jpkm1 
    660647        CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), fsdept(:,:,jk) ) 
    661648      END DO 
    662  
    663       IF ( ln_asmiau ) THEN 
    664  
    665          !-------------------------------------------------------------------- 
    666          ! Incremental Analysis Updating 
    667          !-------------------------------------------------------------------- 
    668  
     649         ! 
     650         !                             !-------------------------------------- 
     651      IF ( ln_asmiau ) THEN            ! Incremental Analysis Updating 
     652         !                             !-------------------------------------- 
     653         ! 
    669654         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN 
    670  
     655            ! 
    671656            it = kt - nit000 + 1 
    672657            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step 
    673  
     658            ! 
    674659            IF(lwp) THEN 
    675660               WRITE(numout,*)  
    … …  
    677662               WRITE(numout,*) '~~~~~~~~~~~~' 
    678663            ENDIF 
    679  
     664            ! 
    680665            ! Update the tracer tendencies 
    681666            DO jk = 1, jpkm1 
    … …  
    700685               ENDIF 
    701686            END DO 
    702  
    703          ENDIF 
    704  
     687            ! 
     688         ENDIF 
     689         ! 
    705690         IF ( kt == nitiaufin_r + 1  ) THEN   ! For bias crcn to work 
    706691            DEALLOCATE( t_bkginc ) 
    707692            DEALLOCATE( s_bkginc ) 
    708693         ENDIF 
    709  
    710  
    711       ELSEIF ( ln_asmdin ) THEN 
    712  
    713          !-------------------------------------------------------------------- 
    714          ! Direct Initialization 
    715          !-------------------------------------------------------------------- 
    716              
     694         !                             !-------------------------------------- 
     695      ELSEIF ( ln_asmdin ) THEN        ! Direct Initialization 
     696         !                             !-------------------------------------- 
     697         !             
    717698         IF ( kt == nitdin_r ) THEN 
    718  
     699            ! 
    719700            neuler = 0  ! Force Euler forward step 
    720  
     701            ! 
    721702            ! Initialize the now fields with the background + increment 
    722703            IF (ln_temnofreeze) THEN 
    … …  
    745726!!gm 
    746727 
    747  
    748             IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)      & 
    749                &  CALL zps_hde    ( kt, jpts, tsb, gtsu, gtsv,        &  ! Partial steps: before horizontal gradient 
    750                &                              rhd, gru , grv          )  ! of t, s, rd at the last ocean level 
    751             IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)      & 
    752                &  CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv,    &    ! Partial steps for top cell (ISF) 
    753                &                                  rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
    754                &                           gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level 
    755  
    756 #if defined key_zdfkpp 
    757             CALL eos( tsn, rhd, fsdept_n(:,:,:) )                      ! Compute rhd 
    758 !!gm fabien            CALL eos( tsn, rhd )                      ! Compute rhd 
    759 #endif 
    760  
     728            IF( ln_zps .AND. .NOT. lk_c1d ) THEN      ! Partial steps: before horizontal gradient 
     729               IF(ln_isfcav) THEN                        ! ocean cavities: top and bottom cells (ISF) 
     730                  CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, gtui, gtvi,     & 
     731                     &                            rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
     732                     &                     grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) 
     733               ELSE                                      ! no ocean cavities: bottom cells 
     734                  CALL zps_hde    ( kt, jpts, tsb, gtsu, gtsv,        &  !  
     735                     &                        rhd, gru , grv          )  ! of t, s, rd at the last ocean level 
     736               ENDIF 
     737            ENDIF 
     738            ! 
    761739            DEALLOCATE( t_bkginc ) 
    762740            DEALLOCATE( s_bkginc ) 
    … …  
    767745      ENDIF 
    768746      ! Perhaps the following call should be in step 
    769       IF   ( ln_seaiceinc  )   CALL seaice_asm_inc ( kt )   ! apply sea ice concentration increment 
     747      IF ( ln_seaiceinc  )   CALL seaice_asm_inc ( kt )   ! apply sea ice concentration increment 
    770748      ! 
    771749   END SUBROUTINE tra_asm_inc 
    … …  
    788766      REAL(wp) :: zincwgt  ! IAU weight for current time step 
    789767      !!---------------------------------------------------------------------- 
    790  
    791       IF ( ln_asmiau ) THEN 
    792  
    793          !-------------------------------------------------------------------- 
    794          ! Incremental Analysis Updating 
    795          !-------------------------------------------------------------------- 
    796  
     768      ! 
     769      !                          !-------------------------------------------- 
     770      IF ( ln_asmiau ) THEN      ! Incremental Analysis Updating 
     771         !                       !-------------------------------------------- 
     772         ! 
    797773         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN 
    798  
     774            ! 
    799775            it = kt - nit000 + 1 
    800776            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step 
    801  
     777            ! 
    802778            IF(lwp) THEN 
    803779               WRITE(numout,*)  
    804                WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', & 
    805                   &  kt,' with IAU weight = ', wgtiau(it) 
     780               WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
    806781               WRITE(numout,*) '~~~~~~~~~~~~' 
    807782            ENDIF 
    808  
     783            ! 
    809784            ! Update the dynamic tendencies 
    810785            DO jk = 1, jpkm1 
    … …  
    812787               va(:,:,jk) = va(:,:,jk) + v_bkginc(:,:,jk) * zincwgt 
    813788            END DO 
    814             
     789            ! 
    815790            IF ( kt == nitiaufin_r ) THEN 
    816791               DEALLOCATE( u_bkginc ) 
    817792               DEALLOCATE( v_bkginc ) 
    818793            ENDIF 
    819  
    820          ENDIF 
    821  
    822       ELSEIF ( ln_asmdin ) THEN  
    823  
    824          !-------------------------------------------------------------------- 
    825          ! Direct Initialization 
    826          !-------------------------------------------------------------------- 
    827           
     794            ! 
     795         ENDIF 
     796         !                          !----------------------------------------- 
     797      ELSEIF ( ln_asmdin ) THEN     ! Direct Initialization 
     798         !                          !----------------------------------------- 
     799         !          
    828800         IF ( kt == nitdin_r ) THEN 
    829  
     801            ! 
    830802            neuler = 0                    ! Force Euler forward step 
    831  
     803            ! 
    832804            ! Initialize the now fields with the background + increment 
    833805            un(:,:,:) = u_bkg(:,:,:) + u_bkginc(:,:,:) 
    834806            vn(:,:,:) = v_bkg(:,:,:) + v_bkginc(:,:,:)   
    835  
     807            ! 
    836808            ub(:,:,:) = un(:,:,:)         ! Update before fields 
    837809            vb(:,:,:) = vn(:,:,:) 
    838   
     810            ! 
    839811            DEALLOCATE( u_bkg    ) 
    840812            DEALLOCATE( v_bkg    ) 
    … …  
    864836      REAL(wp) :: zincwgt  ! IAU weight for current time step 
    865837      !!---------------------------------------------------------------------- 
    866  
    867       IF ( ln_asmiau ) THEN 
    868  
    869          !-------------------------------------------------------------------- 
    870          ! Incremental Analysis Updating 
    871          !-------------------------------------------------------------------- 
    872  
     838      ! 
     839      !                             !----------------------------------------- 
     840      IF ( ln_asmiau ) THEN         ! Incremental Analysis Updating 
     841         !                          !----------------------------------------- 
     842         ! 
    873843         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN 
    874  
     844            ! 
    875845            it = kt - nit000 + 1 
    876846            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step 
    877  
     847            ! 
    878848            IF(lwp) THEN 
    879849               WRITE(numout,*)  
    … …  
    882852               WRITE(numout,*) '~~~~~~~~~~~~' 
    883853            ENDIF 
    884  
     854            ! 
    885855            ! Save the tendency associated with the IAU weighted SSH increment 
    886856            ! (applied in dynspg.*) 
    … …  
    891861               DEALLOCATE( ssh_bkginc ) 
    892862            ENDIF 
    893  
    894          ENDIF 
    895  
    896       ELSEIF ( ln_asmdin ) THEN 
    897  
    898          !-------------------------------------------------------------------- 
    899          ! Direct Initialization 
    900          !-------------------------------------------------------------------- 
    901  
     863            ! 
     864         ENDIF 
     865         !                          !----------------------------------------- 
     866      ELSEIF ( ln_asmdin ) THEN     ! Direct Initialization 
     867         !                          !----------------------------------------- 
     868         ! 
    902869         IF ( kt == nitdin_r ) THEN 
    903  
    904             neuler = 0                    ! Force Euler forward step 
    905  
    906             ! Initialize the now fields the background + increment 
    907             sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:)   
    908  
    909             ! Update before fields 
    910             sshb(:,:) = sshn(:,:)          
    911  
     870            ! 
     871            neuler = 0                                   ! Force Euler forward step 
     872            ! 
     873            sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:)   ! Initialize the now fields the background + increment 
     874            ! 
     875            sshb(:,:) = sshn(:,:)                        ! Update before fields 
     876            ! 
    912877            IF( lk_vvl ) THEN 
    913878               DO jk = 1, jpk 
    … …  
    915880               END DO 
    916881            ENDIF 
    917  
     882            ! 
    918883            DEALLOCATE( ssh_bkg    ) 
    919884            DEALLOCATE( ssh_bkginc ) 
    920  
     885            ! 
    921886         ENDIF 
    922887         ! 
    … …  
    937902      !! 
    938903      !!---------------------------------------------------------------------- 
    939       IMPLICIT NONE 
    940       ! 
    941       INTEGER, INTENT(in)           ::   kt   ! Current time step 
     904      INTEGER, INTENT(in)           ::   kt       ! Current time step 
    942905      INTEGER, INTENT(in), OPTIONAL ::   kindic   ! flag for disabling the deallocation 
    943906      ! 
    … …  
    949912#endif 
    950913      !!---------------------------------------------------------------------- 
    951  
    952       IF ( ln_asmiau ) THEN 
    953  
    954          !-------------------------------------------------------------------- 
    955          ! Incremental Analysis Updating 
    956          !-------------------------------------------------------------------- 
    957  
     914      ! 
     915      !                             !----------------------------------------- 
     916      IF ( ln_asmiau ) THEN         ! Incremental Analysis Updating 
     917         !                          !----------------------------------------- 
     918         ! 
    958919         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN 
    959  
     920            ! 
    960921            it = kt - nit000 + 1 
    961922            zincwgt = wgtiau(it)      ! IAU weight for the current time step  
    962923            ! note this is not a tendency so should not be divided by rdt (as with the tracer and other increments) 
    963  
     924            ! 
    964925            IF(lwp) THEN 
    965926               WRITE(numout,*)  
    966                WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', & 
    967                   &  kt,' with IAU weight = ', wgtiau(it) 
     927               WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
    968928               WRITE(numout,*) '~~~~~~~~~~~~' 
    969929            ENDIF 
    970  
     930            ! 
    971931            ! Sea-ice : LIM-3 case (to add) 
    972  
     932            ! 
    973933#if defined key_lim2 
    974934            ! Sea-ice : LIM-2 case 
    … …  
    1008968 
    1009969#if defined key_cice && defined key_asminc 
    1010             ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
    1011             ndaice_da(:,:) = 0.0_wp 
    1012 #endif 
    1013  
    1014          ENDIF 
    1015  
    1016       ELSEIF ( ln_asmdin ) THEN 
    1017  
    1018          !-------------------------------------------------------------------- 
    1019          ! Direct Initialization 
    1020          !-------------------------------------------------------------------- 
    1021  
     970            ndaice_da(:,:) = 0._wp        ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
     971#endif 
     972 
     973         ENDIF 
     974         !                          !----------------------------------------- 
     975      ELSEIF ( ln_asmdin ) THEN     ! Direct Initialization 
     976         !                          !----------------------------------------- 
     977         ! 
    1022978         IF ( kt == nitdin_r ) THEN 
    1023  
     979            ! 
    1024980            neuler = 0                    ! Force Euler forward step 
    1025  
     981            ! 
    1026982            ! Sea-ice : LIM-3 case (to add) 
    1027  
     983            ! 
    1028984#if defined key_lim2 
    1029985            ! Sea-ice : LIM-2 case. 
    … …  
    1041997               zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt     
    1042998            ELSEWHERE 
    1043                zhicifinc(:,:) = 0.0_wp 
     999               zhicifinc(:,:) = 0._wp 
    10441000            END WHERE 
    10451001            ! 
    … …  
    10501006            ! seaice salinity balancing (to add) 
    10511007#endif 
    1052   
     1008            ! 
    10531009#if defined key_cice && defined key_asminc 
    10541010            ! Sea-ice : CICE case. Pass ice increment tendency into CICE 
    10551011           ndaice_da(:,:) = seaice_bkginc(:,:) / rdt 
    10561012#endif 
    1057            IF ( .NOT. PRESENT(kindic) ) THEN 
    1058               DEALLOCATE( seaice_bkginc ) 
    1059            END IF 
    1060  
     1013            IF ( .NOT. PRESENT(kindic) ) THEN 
     1014               DEALLOCATE( seaice_bkginc ) 
     1015            END IF 
     1016            ! 
    10611017         ELSE 
    1062  
     1018            ! 
    10631019#if defined key_cice && defined key_asminc 
    1064             ! Sea-ice : CICE case. Zero ice increment tendency into CICE  
    1065             ndaice_da(:,:) = 0.0_wp 
    1066 #endif 
    1067           
     1020            ndaice_da(:,:) = 0._wp     ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
     1021 
     1022#endif 
     1023            ! 
    10681024         ENDIF 
    10691025 
    … …  
    11421098! 
    11431099!#endif 
    1144  
     1100         ! 
    11451101      ENDIF 
    1146  
     1102      ! 
    11471103   END SUBROUTINE seaice_asm_inc 
    11481104    

  • trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90

    r2287 r5836  
    66 
    77   IMPLICIT NONE 
    8  
    9    !! * Routine accessibility 
    108   PRIVATE 
    119 
    12    !! * Shared Modules variables 
    13    CHARACTER (LEN=40), PUBLIC, PARAMETER :: & 
    14       & c_asmbkg = 'assim_background_state_Jb',  & !: Filename for storing the  
    15                                                    !: background state for use  
    16                                                    !: in the Jb term 
    17       & c_asmdin = 'assim_background_state_DI',  & !: Filename for storing the  
    18                                                    !: background state for direct  
    19                                                    !: initialization 
    20       & c_asmtrj = 'assim_trj',                  & !: Filename for storing the  
    21                                                    !: reference trajectory 
    22       & c_asminc = 'assim_background_increments'   !: Filename for storing the  
    23                                                    !: increments to the background 
    24                                                    !: state 
     10   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmbkg = 'assim_background_state_Jb'   !: Filename for storing the background state 
     11   !                                                                                  !  for use in the Jb term 
     12   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmdin = 'assim_background_state_DI'   !: Filename for storing the background state 
     13   !                                                                                  !  for direct initialization 
     14   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmtrj = 'assim_trj'                   !: Filename for storing the reference trajectory 
     15   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asminc = 'assim_background_increments' !: Filename for storing the increments  
     16   !                                                                                  !  to the background state 
    2517 
    26    INTEGER, PUBLIC :: nitbkg_r      !: Background time step referenced to nit000 
    27    INTEGER, PUBLIC :: nitdin_r      !: Direct Initialization time step referenced to nit000 
    28    INTEGER, PUBLIC :: nitiaustr_r   !: IAU starting time step referenced to nit000 
    29    INTEGER, PUBLIC :: nitiaufin_r   !: IAU final time step referenced to nit000 
    30    INTEGER, PUBLIC :: nittrjfrq     !: Frequency of trajectory output for 4D-VAR 
     18   INTEGER, PUBLIC ::   nitbkg_r      !: Background time step referenced to nit000 
     19   INTEGER, PUBLIC ::   nitdin_r      !: Direct Initialization time step referenced to nit000 
     20   INTEGER, PUBLIC ::   nitiaustr_r   !: IAU starting time step referenced to nit000 
     21   INTEGER, PUBLIC ::   nitiaufin_r   !: IAU final time step referenced to nit000 
     22   INTEGER, PUBLIC ::   nittrjfrq     !: Frequency of trajectory output for 4D-VAR 
    3123 
    3224   !!---------------------------------------------------------------------- 
    … …  
    3426   !! $Id$ 
    3527   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    36    !!---------------------------------------------------------------------- 
    37  
     28   !!====================================================================== 
    3829END MODULE asmpar 

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r4699 r5836  
    88   !!            3.3  !  2010-09  (D. Storkey) add ice boundary conditions 
    99   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
    10    !!            3.6  !  2012-01  (C. Rousset) add ice boundary conditions for lim3 
     10   !!            3.6  !  2014-01  (C. Rousset) add ice boundary conditions for lim3 
    1111   !!---------------------------------------------------------------------- 
    1212#if defined key_bdy  
    … …  
    2222 
    2323   TYPE, PUBLIC ::   OBC_INDEX    !: Indices and weights which define the open boundary 
    24       INTEGER,          DIMENSION(jpbgrd) ::  nblen 
    25       INTEGER,          DIMENSION(jpbgrd) ::  nblenrim 
    26       INTEGER, POINTER, DIMENSION(:,:)   ::  nbi 
    27       INTEGER, POINTER, DIMENSION(:,:)   ::  nbj 
    28       INTEGER, POINTER, DIMENSION(:,:)   ::  nbr 
    29       INTEGER, POINTER, DIMENSION(:,:)   ::  nbmap 
    30       REAL(wp)   , POINTER, DIMENSION(:,:)   ::  nbw 
    31       REAL(wp)   , POINTER, DIMENSION(:,:)   ::  nbd 
    32       REAL(wp)   , POINTER, DIMENSION(:,:)   ::  nbdout 
    33       REAL(wp)   , POINTER, DIMENSION(:,:)   ::  flagu 
    34       REAL(wp)   , POINTER, DIMENSION(:,:)   ::  flagv 
     24      INTEGER ,          DIMENSION(jpbgrd) ::  nblen 
     25      INTEGER ,          DIMENSION(jpbgrd) ::  nblenrim 
     26      INTEGER , POINTER, DIMENSION(:,:)    ::  nbi 
     27      INTEGER , POINTER, DIMENSION(:,:)    ::  nbj 
     28      INTEGER , POINTER, DIMENSION(:,:)    ::  nbr 
     29      INTEGER , POINTER, DIMENSION(:,:)    ::  nbmap 
     30      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbw 
     31      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbd 
     32      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbdout 
     33      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagu 
     34      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagv 
    3535   END TYPE OBC_INDEX 
    3636 
    … …  
    4141 
    4242   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data 
    43       INTEGER,       DIMENSION(2)     ::  nread 
    44       LOGICAL                         ::  ll_ssh 
    45       LOGICAL                         ::  ll_u2d 
    46       LOGICAL                         ::  ll_v2d 
    47       LOGICAL                         ::  ll_u3d 
    48       LOGICAL                         ::  ll_v3d 
    49       LOGICAL                         ::  ll_tem 
    50       LOGICAL                         ::  ll_sal 
    51       REAL(wp), POINTER, DIMENSION(:)     ::  ssh 
    52       REAL(wp), POINTER, DIMENSION(:)     ::  u2d 
    53       REAL(wp), POINTER, DIMENSION(:)     ::  v2d 
    54       REAL(wp), POINTER, DIMENSION(:,:)   ::  u3d 
    55       REAL(wp), POINTER, DIMENSION(:,:)   ::  v3d 
    56       REAL(wp), POINTER, DIMENSION(:,:)   ::  tem 
    57       REAL(wp), POINTER, DIMENSION(:,:)   ::  sal 
     43      INTEGER          , DIMENSION(2)   ::  nread 
     44      LOGICAL                           ::  ll_ssh 
     45      LOGICAL                           ::  ll_u2d 
     46      LOGICAL                           ::  ll_v2d 
     47      LOGICAL                           ::  ll_u3d 
     48      LOGICAL                           ::  ll_v3d 
     49      LOGICAL                           ::  ll_tem 
     50      LOGICAL                           ::  ll_sal 
     51      REAL(wp), POINTER, DIMENSION(:)   ::  ssh 
     52      REAL(wp), POINTER, DIMENSION(:)   ::  u2d 
     53      REAL(wp), POINTER, DIMENSION(:)   ::  v2d 
     54      REAL(wp), POINTER, DIMENSION(:,:) ::  u3d 
     55      REAL(wp), POINTER, DIMENSION(:,:) ::  v3d 
     56      REAL(wp), POINTER, DIMENSION(:,:) ::  tem 
     57      REAL(wp), POINTER, DIMENSION(:,:) ::  sal 
    5858#if defined key_lim2 
    59       LOGICAL                         ::  ll_frld 
    60       LOGICAL                         ::  ll_hicif 
    61       LOGICAL                         ::  ll_hsnif 
    62       REAL(wp), POINTER, DIMENSION(:)     ::  frld 
    63       REAL(wp), POINTER, DIMENSION(:)     ::  hicif 
    64       REAL(wp), POINTER, DIMENSION(:)     ::  hsnif 
     59      LOGICAL                           ::   ll_frld 
     60      LOGICAL                           ::   ll_hicif 
     61      LOGICAL                           ::   ll_hsnif 
     62      REAL(wp), POINTER, DIMENSION(:)   ::   frld 
     63      REAL(wp), POINTER, DIMENSION(:)   ::   hicif 
     64      REAL(wp), POINTER, DIMENSION(:)   ::   hsnif 
    6565#elif defined key_lim3 
    66       LOGICAL                         ::  ll_a_i 
    67       LOGICAL                         ::  ll_ht_i 
    68       LOGICAL                         ::  ll_ht_s 
    69       REAL, POINTER, DIMENSION(:,:)   ::  a_i   !: now ice leads fraction climatology 
    70       REAL, POINTER, DIMENSION(:,:)   ::  ht_i  !: Now ice  thickness climatology 
    71       REAL, POINTER, DIMENSION(:,:)   ::  ht_s  !: now snow thickness 
     66      LOGICAL                           ::   ll_a_i 
     67      LOGICAL                           ::   ll_ht_i 
     68      LOGICAL                           ::   ll_ht_s 
     69      REAL(wp), POINTER, DIMENSION(:,:) ::   a_i    !: now ice leads fraction climatology 
     70      REAL(wp), POINTER, DIMENSION(:,:) ::   ht_i   !: Now ice  thickness climatology 
     71      REAL(wp), POINTER, DIMENSION(:,:) ::   ht_s   !: now snow thickness 
    7272#endif 
    7373   END TYPE OBC_DATA 
    … …  
    9999   INTEGER, DIMENSION(jp_bdy)           ::   nn_tra_dta     !: = 0 use the initial state as bdy dta ;  
    100100                                                            !: = 1 read it in a NetCDF file 
    101    LOGICAL, DIMENSION(jp_bdy) ::   ln_tra_dmp               !: =T Tracer damping 
    102    LOGICAL, DIMENSION(jp_bdy) ::   ln_dyn3d_dmp             !: =T Baroclinic velocity damping 
    103    REAL(wp),    DIMENSION(jp_bdy) ::   rn_time_dmp              !: Damping time scale in days 
    104    REAL(wp),    DIMENSION(jp_bdy) ::   rn_time_dmp_out          !: Damping time scale in days at radiation outflow points 
     101   LOGICAL , DIMENSION(jp_bdy) ::   ln_tra_dmp              !: =T Tracer damping 
     102   LOGICAL , DIMENSION(jp_bdy) ::   ln_dyn3d_dmp            !: =T Baroclinic velocity damping 
     103   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp             !: Damping time scale in days 
     104   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp_out         !: Damping time scale in days at radiation outflow points 
    105105 
    106106   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_ice_lim       ! Choice of boundary condition for sea ice variables  
    107    INTEGER, DIMENSION(jp_bdy)           ::   nn_ice_lim_dta   !: = 0 use the initial state as bdy dta ;  
     107   INTEGER , DIMENSION(jp_bdy)          ::   nn_ice_lim_dta   !: = 0 use the initial state as bdy dta ;  
    108108                                                              !: = 1 read it in a NetCDF file 
    109    REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_tem             !: choice of the temperature of incoming sea ice 
    110    REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_sal             !: choice of the salinity    of incoming sea ice 
    111    REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_age             !: choice of the age         of incoming sea ice 
     109   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_tem              !: choice of the temperature of incoming sea ice 
     110   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_sal              !: choice of the salinity    of incoming sea ice 
     111   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_age              !: choice of the age         of incoming sea ice 
    112112   ! 
    113113    

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90

    r5656 r5836  
    5959      !! 
    6060      !!---------------------------------------------------------------------- 
    61       INTEGER, INTENT( in ) :: kt     ! Main time step counter 
    62       INTEGER               :: ib_bdy ! Loop index 
    63  
     61      INTEGER, INTENT( in ) ::   kt   ! Main time step counter 
     62      ! 
     63      INTEGER ::   ib_bdy   ! Loop index 
     64      !!---------------------------------------------------------------------- 
     65      ! 
    6466#if defined key_lim3 
    6567      CALL lim_var_glo2eqv 
    6668#endif 
    67  
     69      ! 
    6870      DO ib_bdy=1, nb_bdy 
    69  
     71         ! 
    7072         SELECT CASE( cn_ice_lim(ib_bdy) ) 
    7173         CASE('none') 
    … …  
    7678            CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' ) 
    7779         END SELECT 
    78  
     80         ! 
    7981      END DO 
    80  
     82      ! 
    8183#if defined key_lim3 
    8284      CALL lim_var_zapsmall 
    8385      CALL lim_var_agg(1) 
    8486#endif 
    85  
     87      ! 
    8688   END SUBROUTINE bdy_ice_lim 
     89 
    8790 
    8891   SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy ) 
    … …  
    9699      !!             dimensional baroclinic ocean model with realistic topography. Tellus, 365-382. 
    97100      !!------------------------------------------------------------------------------ 
    98       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    99       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    100       INTEGER,         INTENT(in) ::   kt   ! main time-step counter 
     101      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
     102      TYPE(OBC_DATA),  INTENT(in) ::   dta     ! OBC external data 
     103      INTEGER,         INTENT(in) ::   kt      ! main time-step counter 
    101104      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    102  
     105      ! 
    103106      INTEGER  ::   jpbound            ! 0 = incoming ice 
    104                                        ! 1 = outgoing ice 
     107      !                                ! 1 = outgoing ice 
    105108      INTEGER  ::   jb, jk, jgrd, jl   ! dummy loop indices 
    106109      INTEGER  ::   ji, jj, ii, ij     ! local scalar 
    … …  
    111114     USE ice_2, vt_i => hicm 
    112115#endif 
    113  
    114       !!------------------------------------------------------------------------------ 
    115       ! 
    116       IF( nn_timing == 1 ) CALL timing_start('bdy_ice_frs') 
     116      !!------------------------------------------------------------------------------ 
     117      ! 
     118      IF( nn_timing == 1 )   CALL timing_start('bdy_ice_frs') 
    117119      ! 
    118120      jgrd = 1      ! Everything is at T-points here 
    … …  
    181183            ! condition on ice thickness depends on the ice velocity 
    182184            ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values 
    183             jpbound = 0; ii = ji; ij = jj; 
    184  
     185            jpbound = 0   ;   ii = ji   ;   ij = jj 
     186            ! 
    185187            IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 
    186188            IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 
    187189            IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1 
    188190            IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1 
    189  
     191            ! 
    190192            IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj   ! case ice boundaries = initial conditions 
    191                                                                               !      do not make state variables dependent on velocity 
    192                 
    193  
     193            !                                                                 !      do not make state variables dependent on velocity 
     194            ! 
    194195            rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice 
    195  
     196            ! 
    196197            ! concentration and thickness 
    197198            a_i (ji,jj,jl) = a_i (ii,ij,jl) * rswitch 
    198199            ht_i(ji,jj,jl) = ht_i(ii,ij,jl) * rswitch 
    199200            ht_s(ji,jj,jl) = ht_s(ii,ij,jl) * rswitch 
    200  
     201            ! 
    201202            ! Ice and snow volumes 
    202203            v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 
    203204            v_s(ji,jj,jl) = ht_s(ji,jj,jl) * a_i(ji,jj,jl) 
    204  
     205            ! 
    205206            SELECT CASE( jpbound ) 
    206  
    207             CASE( 0 ) ! velocity is inward 
    208  
     207            ! 
     208            CASE( 0 )   ! velocity is inward 
     209               ! 
    209210               ! Ice salinity, age, temperature 
    210211               sm_i(ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * rn_simin 
    … …  
    218219                  s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin 
    219220               END DO 
    220                 
    221             CASE( 1 ) ! velocity is outward 
    222   
     221               ! 
     222            CASE( 1 )   ! velocity is outward 
     223               ! 
    223224               ! Ice salinity, age, temperature 
    224225               sm_i(ji,jj,jl)   = rswitch * sm_i(ii,ij,jl)  + ( 1.0 - rswitch ) * rn_simin 
    … …  
    232233                  s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin 
    233234               END DO 
    234  
     235               ! 
    235236            END SELECT 
    236  
    237             ! if salinity is constant, then overwrite rn_ice_sal 
    238             IF( nn_icesal == 1 ) THEN 
    239                sm_i(ji,jj,jl)   = rn_icesal 
     237            ! 
     238            IF( nn_icesal == 1 ) THEN     ! constant salinity : overwrite rn_ice_sal 
     239               sm_i(ji,jj  ,jl) = rn_icesal 
    240240               s_i (ji,jj,:,jl) = rn_icesal 
    241241            ENDIF 
    242  
     242            ! 
    243243            ! contents 
    244244            smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
    … …  
    259259               e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i 
    260260            END DO 
    261  
     261            ! 
    262262         END DO 
    263   
     263         ! 
    264264         CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy ) 
    265265         CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy ) 
    … …  
    267267         CALL lbc_bdy_lnk(  v_i(:,:,jl), 'T', 1., ib_bdy ) 
    268268         CALL lbc_bdy_lnk(  v_s(:,:,jl), 'T', 1., ib_bdy ) 
    269   
     269         ! 
    270270         CALL lbc_bdy_lnk( smv_i(:,:,jl), 'T', 1., ib_bdy ) 
    271271         CALL lbc_bdy_lnk(  sm_i(:,:,jl), 'T', 1., ib_bdy ) 
    … …  
    280280            CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy ) 
    281281         END DO 
    282  
     282         ! 
    283283      END DO !jl 
    284      
     284      ! 
    285285#endif 
    286286      !       
    287       IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_frs') 
     287      IF( nn_timing == 1 )   CALL timing_stop('bdy_ice_frs') 
    288288      ! 
    289289   END SUBROUTINE bdy_ice_frs 
    … …  
    300300      !! 2013-06 : C. Rousset 
    301301      !!------------------------------------------------------------------------------ 
    302       !! 
    303302      CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points 
     303      ! 
    304304      INTEGER  ::   jb, jgrd           ! dummy loop indices 
    305305      INTEGER  ::   ji, jj             ! local scalar 
    306306      INTEGER  ::   ib_bdy             ! Loop index 
    307307      REAL(wp) ::   zmsk1, zmsk2, zflag 
    308      !!------------------------------------------------------------------------------ 
     308      !!------------------------------------------------------------------------------ 
    309309      ! 
    310310      IF( nn_timing == 1 ) CALL timing_start('bdy_ice_lim_dyn') 
    … …  
    313313         ! 
    314314         SELECT CASE( cn_ice_lim(ib_bdy) ) 
    315  
     315         ! 
    316316         CASE('none') 
    317  
    318317            CYCLE 
    319              
     318            ! 
    320319         CASE('frs') 
    321              
     320            ! 
    322321            IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions  
    323                                                                !      do not change ice velocity (it is only computed by rheology) 
    324   
     322            !                                                  !      do not change ice velocity (it is only computed by rheology) 
    325323            SELECT CASE ( cd_type ) 
    326                 
    327             CASE ( 'U' ) 
    328                 
     324            !      
     325            CASE ( 'U' )   
    329326               jgrd = 2      ! u velocity 
    330327               DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) 
    … …  
    332329                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    333330                  zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd) 
    334                    
     331                  ! 
    335332                  IF ( ABS( zflag ) == 1. ) THEN  ! eastern and western boundaries 
    336333                     ! one of the two zmsk is always 0 (because of zflag) 
    337334                     zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji+1,jj) ) ) ! 0 if no ice 
    338335                     zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji-1,jj) ) ) ! 0 if no ice 
    339                       
     336                     !   
    340337                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 
    341338                     u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
    … …  
    349346                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice 
    350347                  u_ice(ji,jj) = rswitch * u_ice(ji,jj) 
    351                    
    352                ENDDO 
    353                 
     348                  ! 
     349               END DO 
    354350               CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy ) 
    355                 
     351               ! 
    356352            CASE ( 'V' ) 
    357                 
    358353               jgrd = 3      ! v velocity 
    359354               DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) 
    … …  
    361356                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    362357                  zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd) 
    363                    
     358                  ! 
    364359                  IF ( ABS( zflag ) == 1. ) THEN  ! northern and southern boundaries 
    365360                     ! one of the two zmsk is always 0 (because of zflag) 
    366361                     zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj+1) ) ) ! 0 if no ice 
    367362                     zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj-1) ) ) ! 0 if no ice 
    368                       
     363                     !   
    369364                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 
    370365                     v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
    … …  
    378373                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice 
    379374                  v_ice(ji,jj) = rswitch * v_ice(ji,jj) 
    380                    
    381                ENDDO 
    382                 
     375                  ! 
     376               END DO 
    383377               CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy ) 
    384                    
     378               ! 
    385379            END SELECT 
    386              
     380            ! 
    387381         CASE DEFAULT 
    388382            CALL ctl_stop( 'bdy_ice_lim_dyn : unrecognised option for open boundaries for ice fields' ) 
    389383         END SELECT 
    390           
    391       ENDDO 
    392  
     384         ! 
     385      END DO 
     386      ! 
    393387      IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_lim_dyn') 
    394        
     388      ! 
    395389    END SUBROUTINE bdy_ice_lim_dyn 
    396390 

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r5656 r5836  
    7676      INTEGER  ::   ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 
    7777      INTEGER  ::   icount, icountr, ibr_max, ilen1, ibm1  ! local integers 
    78       INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy         !   -       - 
     78      INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy     !   -       - 
    7979      INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       - 
    8080      INTEGER  ::   jpbdtau, jpbdtas                       !   -       - 

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r5643 r5836  
    1515   !!   'key_dynspg_flt'                              filtered free surface 
    1616   !!---------------------------------------------------------------------- 
    17    USE timing          ! Timing 
    1817   USE oce             ! ocean dynamics and tracers  
    19    USE sbcisf          ! ice shelf 
     18   USE bdy_oce         ! ocean open boundary conditions 
     19   USE sbc_oce         ! ocean surface boundary conditions 
    2020   USE dom_oce         ! ocean space and time domain  
    2121   USE phycst          ! physical constants 
    22    USE bdy_oce         ! ocean open boundary conditions 
     22   USE sbcisf          ! ice shelf 
     23   ! 
     24   USE in_out_manager  ! I/O manager 
    2325   USE lib_mpp         ! for mppsum 
    24    USE in_out_manager  ! I/O manager 
    25    USE sbc_oce         ! ocean surface boundary conditions 
     26   USE timing          ! Timing 
     27   USE lib_fortran     ! Fortran routines library 
    2628 
    2729   IMPLICIT NONE 
    … …  
    3335#  include "domzgr_substitute.h90" 
    3436   !!---------------------------------------------------------------------- 
    35    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     37   !! NEMO/OPA 3.6 , NEMO Consortium (2014) 
    3638   !! $Id$  
    3739   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7880      TYPE(OBC_INDEX), POINTER :: idx 
    7981      !!----------------------------------------------------------------------------- 
    80  
    81       IF( nn_timing == 1 ) CALL timing_start('bdy_vol') 
    82  
     82      ! 
     83      IF( nn_timing == 1 )   CALL timing_start('bdy_vol') 
     84      ! 
    8385      IF( ln_vol ) THEN 
    84  
     86      ! 
    8587      IF( kt == nit000 ) THEN  
    8688         IF(lwp) WRITE(numout,*) 
    … …  
    9193      ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 
    9294      ! ----------------------------------------------------------------------- 
    93       z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0 
     95!!gm replace these lines : 
     96      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 
    9497      IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain 
     98!!gm   by : 
     99!!gm      z_cflxemp = glob_sum(  ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:)  ) / rau0 
     100!!gm 
    95101 
    96102      ! Transport through the unstructured open boundary 
    97103      ! ------------------------------------------------ 
    98       zubtpecor = 0.e0 
     104      zubtpecor = 0._wp 
    99105      DO ib_bdy = 1, nb_bdy 
    100106         idx => idx_bdy(ib_bdy) 
    101  
     107         ! 
    102108         jgrd = 2                               ! cumulate u component contribution first  
    103109         DO jb = 1, idx%nblenrim(jgrd) 
    … …  
    116122            END DO 
    117123         END DO 
    118  
     124         ! 
    119125      END DO 
    120126      IF( lk_mpp )   CALL mpp_sum( zubtpecor )   ! sum over the global domain 
    … …  
    123129      ! ------------------------------ 
    124130      IF( nn_volctl==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot  
    125       ELSE                   ;   zubtpecor =   zubtpecor             / bdysurftot 
     131      ELSE                      ;   zubtpecor =   zubtpecor             / bdysurftot 
    126132      END IF 
    127133 
    128134      ! Correction of the total velocity on the unstructured boundary to respect the mass flux conservation 
    129135      ! ------------------------------------------------------------- 
    130       ztranst = 0.e0 
     136      ztranst = 0._wp 
    131137      DO ib_bdy = 1, nb_bdy 
    132138         idx => idx_bdy(ib_bdy) 
    133  
     139         ! 
    134140         jgrd = 2                               ! correct u component 
    135141         DO jb = 1, idx%nblenrim(jgrd) 
    … …  
    150156            END DO 
    151157         END DO 
    152  
     158         ! 
    153159      END DO 
    154160      IF( lk_mpp )   CALL mpp_sum( ztranst )   ! sum over the global domain 
    … …  
    169175      ! 
    170176      END IF ! ln_vol 
    171  
     177      ! 
    172178   END SUBROUTINE bdy_vol 
    173179 

  • trunk/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90

    r5215 r5836  
    4848      !!---------------------------------------------------------------------- 
    4949      ! 
    50  
    5150      REWIND( numnam_ref )              ! Namelist namc1d in reference namelist : Tracer advection scheme 
    5251      READ  ( numnam_ref, namc1d, IOSTAT = ios, ERR = 901) 
    … …  
    5756902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d in configuration namelist', lwp ) 
    5857      IF(lwm) WRITE ( numond, namc1d ) 
    59  
    6058      ! 
    6159      IF(lwp) THEN                    ! Control print 
    … …  
    6967      ENDIF 
    7068      ! 
    71       ! 
    7269   END SUBROUTINE c1d_init 
    7370 
    … …  
    7774   !!---------------------------------------------------------------------- 
    7875   USE par_kind         ! kind parameters 
    79  
    8076   LOGICAL, PUBLIC, PARAMETER ::   lk_c1d = .FALSE.   !: 1D config. flag de-activated 
    8177   REAL(wp)                   ::   rn_lat1d, rn_lon1d 
    8278   LOGICAL , PUBLIC           ::   ln_c1d_locpt = .FALSE.  
    83  
    8479CONTAINS 
    85  
    8680   SUBROUTINE c1d_init               ! Dummy routine 
    8781   END SUBROUTINE c1d_init 
    88  
    8982#endif 
    9083 

  • trunk/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90

    r5412 r5836  
    8282      IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz 
    8383      IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz 
    84       IF( lk_zdfkpp  )   CALL zdf_kpp( kstp )            ! KPP closure scheme for Kz 
    8584      IF( lk_zdfcst  )   THEN                            ! Constant Kz (reset avt, avm[uv] to the background value) 
    8685         avt (:,:,:) = rn_avt0 * tmask(:,:,:) 
    … …  
    9392      ENDIF 
    9493      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity 
    95  
    9694      IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing 
    97  
    98       IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
    99          &               CALL zdf_ddm( kstp )         ! double diffusive mixing 
    100           
     95      IF( lk_zdfddm  )   CALL zdf_ddm( kstp )         ! double diffusive mixing 
    10196                         CALL zdf_mxl( kstp )         ! mixed layer depth 
    10297 
    … …  
    128123      IF( ln_traqsr )   CALL tra_qsr( kstp )       ! penetrative solar radiation qsr 
    129124      IF( ln_tradmp )   CALL tra_dmp( kstp )       ! internal damping trends- tracers 
    130       IF( lk_zdfkpp )   CALL tra_kpp( kstp )       ! KPP non-local tracer fluxes 
    131125                        CALL tra_zdf( kstp )       ! vertical mixing 
    132126                        CALL eos( tsn, rhd, rhop, gdept_0(:,:,:) )   ! now potential density for zdfmxl 

  • trunk/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r5217 r5836  
    1111   !!                       other variables needed to be passed to TOP 
    1212   !!---------------------------------------------------------------------- 
    13    USE oce             ! ocean dynamics and tracers  
    14    USE dom_oce         ! ocean space and time domain 
    15    USE ldftra_oce      ! ocean active tracers: lateral physics 
    16    USE sbc_oce         ! Surface boundary condition: ocean fields 
    17    USE zdf_oce         ! vertical  physics: ocean fields 
    18    USE zdfddm          ! vertical  physics: double diffusion 
    19    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    20    USE in_out_manager  ! I/O manager 
    21    USE timing          ! preformance summary 
    22    USE wrk_nemo        ! working array 
    2313   USE crs 
    2414   USE crsdom 
    2515   USE crslbclnk 
    26    USE iom 
     16   USE oce             ! ocean dynamics and tracers  
     17   USE dom_oce         ! ocean space and time domain 
     18   USE sbc_oce         ! Surface boundary condition: ocean fields 
     19   USE zdf_oce         ! vertical  physics: ocean fields 
     20   USE ldftra          ! ocean active tracers: lateral diffusivity & EIV coefficients 
     21   USE zdfddm          ! vertical  physics: double diffusion 
     22   ! 
     23   USE in_out_manager  ! I/O manager 
     24   USE iom             !  
     25   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     26   USE timing          ! preformance summary 
     27   USE wrk_nemo        ! working array 
    2728 
    2829   IMPLICIT NONE 
    … …  
    3031 
    3132   PUBLIC   crs_fld                 ! routines called by step.F90 
    32  
    3333 
    3434   !! * Substitutions 
    … …  
    3737#  include "vectopt_loop_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    39    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     39   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    4040   !! $Id$ 
    4141   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5656      !! ** Method  :   
    5757      !!---------------------------------------------------------------------- 
    58       !! 
    59        
    60       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    61       !! 
    62       INTEGER               ::   ji, jj, jk              ! dummy loop indices 
    63       !! 
    64       REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3 
    65       REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs  
    66       REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs ! 
    67       REAL(wp)       :: z2dcrsu, z2dcrsv 
    68       !! 
    69        !!---------------------------------------------------------------------- 
     58      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     59      ! 
     60      INTEGER  ::   ji, jj, jk        ! dummy loop indices 
     61      REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars 
     62      ! 
     63      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zfse3t, zfse3u, zfse3v, zfse3w   ! 3D workspace for e3 
     64      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zt, zt_crs 
     65      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zs, zs_crs   
     66      !!---------------------------------------------------------------------- 
    7067      !  
    71  
    7268      IF( nn_timing == 1 )   CALL timing_start('crs_fld') 
    7369 
    7470      !  Initialize arrays 
    75       CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w ) 
    76       CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v ) 
    77       CALL wrk_alloc( jpi, jpj, jpk, zt, zs       ) 
     71      CALL wrk_alloc( jpi,jpj,jpk,  zfse3t, zfse3w ) 
     72      CALL wrk_alloc( jpi,jpj,jpk,  zfse3u, zfse3v ) 
     73      CALL wrk_alloc( jpi,jpj,jpk,   zt    , zs     ) 
    7874      ! 
    7975      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 
    … …  
    169165      CALL iom_put( "eken", rke_crs ) 
    170166 
    171       !  Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 )  
     167      !  Horizontal divergence ( following OPA_SRC/DYN/divhor.F90 )  
    172168      DO jk = 1, jpkm1 
    173169         DO ji = 2, jpi_crsm1 

  • trunk/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r5215 r5836  
    77   !!---------------------------------------------------------------------- 
    88 
    9    USE timing                   ! Timing 
     9   !!---------------------------------------------------------------------- 
     10   !!  crs_init    :  
     11   !!---------------------------------------------------------------------- 
     12   USE par_kind, ONLY: wp 
    1013   USE par_oce                  ! For parameter jpi,jpj,jphgr_msh 
    1114   USE dom_oce                  ! For parameters in par_oce (jperio, lk_vvl) 
    12    USE crs                  ! Coarse grid domain 
     15   USE crs                      ! Coarse grid domain 
    1316   USE phycst, ONLY: omega, rad ! physical constants 
    14    USE wrk_nemo  
    15    USE in_out_manager 
    16    USE par_kind, ONLY: wp 
    17    USE iom 
    1817   USE crsdom 
    1918   USE crsdomwri 
    2019   USE crslbclnk 
     20   ! 
     21   USE iom 
     22   USE in_out_manager 
    2123   USE lib_mpp 
     24   USE wrk_nemo  
     25   USE timing                   ! Timing 
    2226 
    2327   IMPLICIT NONE 
    2428   PRIVATE 
    2529 
    26    PUBLIC  crs_init 
     30   PUBLIC   crs_init   ! called by nemogcm.F90 module 
    2731 
    2832   !! * Substitutions 
    2933#  include "domzgr_substitute.h90" 
    30  
     34   !!---------------------------------------------------------------------- 
    3135   !! $Id$ 
     36   !!---------------------------------------------------------------------- 
    3237CONTAINS 
    3338    
    … …  
    6570      !!               - Read in pertinent data ? 
    6671      !!------------------------------------------------------------------- 
    67       !! Local variables 
    6872      INTEGER  :: ji,jj,jk      ! dummy indices 
    6973      INTEGER  :: ierr                                ! allocation error status 
    … …  
    183187      
    184188     ! 
    185      CALL wrk_alloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w ) 
     189     CALL wrk_alloc( jpi,jpj,jpk,  zfse3t, zfse3u, zfse3v, zfse3w ) 
    186190     ! 
    187191     zfse3t(:,:,:) = fse3t(:,:,:) 
    … …  
    200204     !    3.d.3   Vertical scale factors 
    201205     ! 
    202     
    203    
    204206     CALL crs_dom_e3( e1t, e2t, zfse3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs) 
    205207     CALL crs_dom_e3( e1u, e2u, zfse3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs) 
    … …  
    207209     CALL crs_dom_e3( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs) 
    208210 
    209      ! Reset 0 to e3t_0 or e3w_0 
     211     ! Replace 0 by e3t_0 or e3w_0 
    210212     DO jk = 1, jpk 
    211213        DO ji = 1, jpi_crs 
    … …  
    247249     ENDIF 
    248250      
    249      !--------------------------------------------------------- 
    250      ! 7. Finish and clean-up 
    251      !--------------------------------------------------------- 
    252      CALL wrk_dealloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w ) 
    253  
    254  
     251      !--------------------------------------------------------- 
     252      ! 7. Finish and clean-up 
     253      !--------------------------------------------------------- 
     254      CALL wrk_dealloc( jpi,jpj,jpk,   zfse3t, zfse3u, zfse3v, zfse3w ) 
     255      ! 
    255256   END SUBROUTINE crs_init 
    256257     
    257258   !!====================================================================== 
    258  
    259259END MODULE crsini 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r5253 r5836  
    77   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_diaar5   || defined key_esopa 
     9#if defined key_diaar5 
    1010   !!---------------------------------------------------------------------- 
    1111   !!   'key_diaar5'  :                           activate ar5 diagnotics 
    … …  
    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 ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r5506 r5836  
    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 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

    r5363 r5836  
    88   !!                 !  1997-08  (G. Madec)  optimization 
    99   !!                 !  1999-07  (E. Guilyardi)  hd28 + heat content  
    10    !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module 
    11    !!   NEMO     3.2  !  2009-07  (S. Masson) hc300 bugfix + cleaning + add new diag 
    12    !!---------------------------------------------------------------------- 
    13 #if   defined key_diahth   ||   defined key_esopa 
     10   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module 
     11   !!            3.2  !  2009-07  (S. Masson) hc300 bugfix + cleaning + add new diag 
     12   !!---------------------------------------------------------------------- 
     13#if   defined key_diahth 
    1414   !!---------------------------------------------------------------------- 
    1515   !!   'key_diahth' :                              thermocline depth diag. 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r5566 r5836  
    1717   !!                 ! 2005-11  (V. Garnier) Surface pressure gradient organization 
    1818   !!            3.2  ! 2008-11  (B. Lemaire) creation from old diawri 
     19   !!            3.7  ! 2014-01  (G. Madec) remove eddy induced velocity from no-IOM output 
     20   !!                 !                     change name of output variables in dia_wri_state 
    1921   !!---------------------------------------------------------------------- 
    2022 
    … …  
    2729   USE dynadv, ONLY: ln_dynadv_vec 
    2830   USE zdf_oce         ! ocean vertical physics 
    29    USE ldftra_oce      ! ocean active tracers: lateral physics 
    30    USE ldfdyn_oce      ! ocean dynamics: lateral physics 
    31    USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv 
     31   USE ldftra          ! lateral physics: eddy diffusivity coef. 
    3232   USE sol_oce         ! solver variables 
    3333   USE sbc_oce         ! Surface boundary condition: ocean fields 
    … …  
    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) 
    … …  
    401401      !!      Each nwrite time step, output the instantaneous or mean fields 
    402402      !!---------------------------------------------------------------------- 
    403       !! 
    404       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    405       !! 
     403      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     404      ! 
    406405      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout 
    407406      CHARACTER (len=40) ::   clhstnam, clop, clmx           ! local names 
    … …  
    412411      INTEGER  ::   jn, ierror                               ! local integers 
    413412      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt           ! local scalars 
    414       !! 
     413      ! 
    415414      REAL(wp), POINTER, DIMENSION(:,:)   :: zw2d       ! 2D workspace 
    416415      REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace 
    … …  
    419418      IF( nn_timing == 1 )   CALL timing_start('dia_wri') 
    420419      ! 
    421       CALL wrk_alloc( jpi , jpj      , zw2d ) 
    422       IF ( ln_traldf_gdia .OR. lk_vvl )  call wrk_alloc( jpi , jpj , jpk  , zw3d ) 
     420                     CALL wrk_alloc( jpi,jpj      , zw2d ) 
     421      IF( lk_vvl )   CALL wrk_alloc( jpi,jpj,jpk  , zw3d ) 
    423422      ! 
    424423      ! Output the initial state and forcings 
    … …  
    657656          
    658657         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 ) 
     658!         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX  
     659!            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout ) 
    661660#if defined key_diahth 
    662661         CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth 
    … …  
    682681         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un 
    683682            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 
    684          IF( ln_traldf_gdia ) THEN 
    685             CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv 
    686                  &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 
    687          ELSE 
    688 #if defined key_diaeiv 
    689             CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv 
    690             &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 
    691 #endif 
    692          END IF 
    693683         !                                                                                      !!! nid_U : 2D 
    694684         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau 
    … …  
    700690         CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vn 
    701691            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 
    702          IF( ln_traldf_gdia ) THEN 
    703             CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv 
    704                  &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 
    705          ELSE  
    706 #if defined key_diaeiv 
    707             CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv 
    708             &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 
    709 #endif 
    710          END IF 
    711692         !                                                                                      !!! nid_V : 2D 
    712693         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau 
    … …  
    718699         CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! wn 
    719700            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    720          IF( ln_traldf_gdia ) THEN 
    721             CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv 
    722                  &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    723          ELSE 
    724 #if defined key_diaeiv 
    725             CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv 
    726                  &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    727 #endif 
    728          END IF 
    729701         CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt 
    730702            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    … …  
    737709         ENDIF 
    738710         !                                                                                      !!! nid_W : 2D 
    739 #if defined key_traldf_c2d 
    740          CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity"           , "m2/s"   ,   &  ! ahtw 
    741             &          jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    742 # if defined key_traldf_eiv  
    743             CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s",   &  ! aeiw 
    744                &       jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    745 # endif 
    746 #endif 
    747  
    748711         CALL histend( nid_W, snc4chunks=snc4set ) 
    749712 
    … …  
    853816 
    854817      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current 
    855       IF( ln_traldf_gdia ) THEN 
    856          IF (.not. ALLOCATED(psix_eiv))THEN 
    857             ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 
    858             IF( lk_mpp   )   CALL mpp_sum ( ierr ) 
    859             IF( ierr > 0 )   CALL ctl_stop('STOP', 'diawri: unable to allocate psi{x,y}_eiv') 
    860             psix_eiv(:,:,:) = 0.0_wp 
    861             psiy_eiv(:,:,:) = 0.0_wp 
    862          ENDIF 
    863          DO jk=1,jpkm1 
    864             zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz 
    865          END DO 
    866          zw3d(:,:,jpk) = 0._wp 
    867          CALL histwrite( nid_U, "vozoeivu", it, zw3d, ndim_U , ndex_U )           ! i-eiv current 
    868       ELSE 
    869 #if defined key_diaeiv 
    870          CALL histwrite( nid_U, "vozoeivu", it, u_eiv, ndim_U , ndex_U )          ! i-eiv current 
    871 #endif 
    872       ENDIF 
    873818      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress 
    874819 
    875820      CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current 
    876       IF( ln_traldf_gdia ) THEN 
    877          DO jk=1,jpk-1 
    878             zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz 
    879          END DO 
    880          zw3d(:,:,jpk) = 0._wp 
    881          CALL histwrite( nid_V, "vomeeivv", it, zw3d, ndim_V , ndex_V )           ! j-eiv current 
    882       ELSE 
    883 #if defined key_diaeiv 
    884          CALL histwrite( nid_V, "vomeeivv", it, v_eiv, ndim_V , ndex_V )          ! j-eiv current 
    885 #endif 
    886       ENDIF 
    887821      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress 
    888822 
    889823      CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current 
    890       IF( ln_traldf_gdia ) THEN 
    891          DO jk=1,jpk-1 
    892             DO jj = 2, jpjm1 
    893                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 
    896                END DO 
    897             END DO 
    898          END DO 
    899          zw3d(:,:,jpk) = 0._wp 
    900          CALL histwrite( nid_W, "voveeivw", it, zw3d          , ndim_T, ndex_T )    ! vert. eiv current 
    901       ELSE 
    902 #   if defined key_diaeiv 
    903          CALL histwrite( nid_W, "voveeivw", it, w_eiv          , ndim_T, ndex_T )    ! vert. eiv current 
    904 #   endif 
    905       ENDIF 
    906824      CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef. 
    907825      CALL histwrite( nid_W, "votkeavm", it, avmu           , ndim_T, ndex_T )    ! T vert. eddy visc. coef. 
    … …  
    909827         CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T )    ! S vert. eddy diff. coef. 
    910828      ENDIF 
    911 #if defined key_traldf_c2d 
    912       CALL histwrite( nid_W, "soleahtw", it, ahtw          , ndim_hT, ndex_hT )   ! lateral eddy diff. coef. 
    913 # if defined key_traldf_eiv 
    914          CALL histwrite( nid_W, "soleaeiw", it, aeiw       , ndim_hT, ndex_hT )   ! EIV coefficient at w-point 
    915 # endif 
    916 #endif 
    917829 
    918830      ! 3. Close all files 
    … …  
    925837      ENDIF 
    926838      ! 
    927       CALL wrk_dealloc( jpi , jpj      , zw2d ) 
    928       IF ( ln_traldf_gdia .OR. lk_vvl )  call wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
     839                     CALL wrk_dealloc( jpi , jpj        , zw2d ) 
     840      IF( lk_vvl )   CALL wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
    929841      ! 
    930842      IF( nn_timing == 1 )   CALL timing_stop('dia_wri') 
    … …  
    958870      !!---------------------------------------------------------------------- 
    959871      !  
    960 !     IF( nn_timing == 1 )   CALL timing_start('dia_wri_state') ! not sure this works for routines not called in first timestep 
    961  
    962872      ! 0. Initialisation 
    963873      ! ----------------- 
    … …  
    1018928         CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      ,   &   ! t-point depth 
    1019929            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1020       END IF 
     930      ENDIF 
    1021931 
    1022932#if defined key_lim2 
    … …  
    1042952      CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity 
    1043953      CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity 
    1044       CALL histwrite( id_i, "sowaflup", kt, (emp-rnf )       , jpi*jpj    , idex )    ! freshwater budget 
     954      CALL histwrite( id_i, "sowaflup", kt, emp-rnf          , jpi*jpj    , idex )    ! freshwater budget 
    1045955      CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux 
    1046956      CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux 
    … …  
    1060970      ENDIF 
    1061971#endif 
    1062         
    1063 !     IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep 
    1064972      !  
    1065  
    1066973   END SUBROUTINE dia_wri_state 
    1067974   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90

    r5506 r5836  
    7171      !!                                   =2 put at location runoff 
    7272      !!---------------------------------------------------------------------- 
    73       INTEGER ::   jc            ! dummy loop indices 
    74       INTEGER :: isrow           ! local index 
    75       !!---------------------------------------------------------------------- 
    76        
     73      INTEGER ::   jc      ! dummy loop indices 
     74      INTEGER ::   isrow   ! local index 
     75      !!---------------------------------------------------------------------- 
     76      ! 
    7777      IF(lwp) WRITE(numout,*) 
    7878      IF(lwp) WRITE(numout,*)'dom_clo : closed seas ' 
    7979      IF(lwp) WRITE(numout,*)'~~~~~~~' 
    80  
     80      ! 
    8181      ! initial values 
    8282      ncsnr(:) = 1  ;  ncsi1(:) = 1  ;  ncsi2(:) = 1  ;  ncsir(:,:) = 1 
    8383      ncstt(:) = 0  ;  ncsj1(:) = 1  ;  ncsj2(:) = 1  ;  ncsjr(:,:) = 1 
    84  
     84      ! 
    8585      ! set the closed seas (in data domain indices) 
    8686      ! ------------------- 
    87  
     87      ! 
    8888      IF( cp_cfg == "orca" ) THEN 
    8989         ! 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r5123 r5836  
    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 
    … …  
    2021 
    2122   IMPLICIT NONE 
    22    PUBLIC             ! allows the acces to par_oce when dom_oce is used 
    23    !                  ! exception to coding rules... to be suppressed ??? 
     23   PUBLIC             ! allows the acces to par_oce when dom_oce is used (exception to coding rules) 
    2424 
    2525   PUBLIC dom_oce_alloc  ! Called from nemogcm.F90 
    … …  
    107107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dtra  !: = 2*rdttra except at nit000 (=rdttra) if neuler=0 
    108108 
    109    !                                         !!* Namelist namcla : cross land advection 
    110    INTEGER, PUBLIC ::   nn_cla               !: =1 cross land advection for exchanges through some straits (ORCA2) 
    111  
    112109   !!---------------------------------------------------------------------- 
    113110   !! space domain parameters 
    … …  
    158155   !! horizontal curvilinear coordinate and scale factors 
    159156   !! --------------------------------------------------------------------- 
    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) 
     157   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   glamt , glamu, glamv , glamf    !: longitude at t, u, v, f-points [degree] 
     158   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gphit , gphiu, gphiv , gphif    !: latitude  at t, u, v, f-points [degree] 
     159   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1t   , e2t  , r1_e1t, r1_e2t   !: t-point horizontal scale factors    [m] 
     160   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1u   , e2u  , r1_e1u, r1_e2u   !: horizontal scale factors at u-point [m] 
     161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1v   , e2v  , r1_e1v, r1_e2v   !: horizontal scale factors at v-point [m] 
     162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m] 
     163   ! 
     164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point 
     165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point 
     166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point 
     167   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
     168   ! 
     169   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff                              !: coriolis factor                   [1/s] 
    170170 
    171171   !!---------------------------------------------------------------------- 
    … …  
    216216   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0           !: reference depth at t-       points (meters) 
    217217   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 
    224218 
    225219   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 
    … …  
    265259 
    266260   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4) 
    267  
    268 #if defined key_noslip_accurate 
    269    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  )  :: npcoa              !: ??? 
    270    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: nicoa, njcoa       !: ??? 
    271 #endif 
    272261 
    273262   !!---------------------------------------------------------------------- 
    … …  
    333322   INTEGER FUNCTION dom_oce_alloc() 
    334323      !!---------------------------------------------------------------------- 
    335       INTEGER, DIMENSION(12) :: ierr 
     324      INTEGER, DIMENSION(13) :: ierr 
    336325      !!---------------------------------------------------------------------- 
    337326      ierr(:) = 0 
    … …  
    346335         &      tpol(jpiglo)  , fpol(jpiglo)                               , STAT=ierr(2) ) 
    347336         ! 
    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) )      
     337      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     & 
     338         &      gphit(jpi,jpj) ,    gphiu(jpi,jpj) ,  gphiv(jpi,jpj) ,  gphif(jpi,jpj) ,     & 
     339         &       e1t (jpi,jpj) ,     e2t (jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,     & 
     340         &       e1u (jpi,jpj) ,     e2u (jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,     & 
     341         &       e1v (jpi,jpj) ,     e2v (jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,     & 
     342         &       e1f (jpi,jpj) ,     e2f (jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,     & 
     343         &      e1e2t(jpi,jpj) , r1_e1e2t(jpi,jpj)                                     ,     & 
     344         &      e1e2u(jpi,jpj) , r1_e1e2u(jpi,jpj) , e2_e1u(jpi,jpj)                   ,     & 
     345         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     & 
     346         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     & 
     347         &        ff (jpi,jpj)                                                         , STAT=ierr(3) ) 
    353348         ! 
    354349      ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) ,                         & 
    … …  
    364359         &      gdept_b (jpi,jpj,jpk) ,gdepw_b(jpi,jpj,jpk) , e3w_b (jpi,jpj,jpk) ,                           & 
    365360         &      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) )                           
     361         &      ehu_a   (jpi,jpj)     , ehv_a (jpi,jpj),                                                     & 
     362         &      ehur_a  (jpi,jpj)     , ehvr_a(jpi,jpj),                                                     & 
     363         &      ehu_b   (jpi,jpj)     , ehv_b (jpi,jpj),                                                     & 
     364         &      ehur_b  (jpi,jpj)     , ehvr_b(jpi,jpj),                                  STAT=ierr(5) )                           
    370365#endif 
    371366         ! 
    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)  ) 
     367      ALLOCATE( hu(jpi,jpj) , hur(jpi,jpj) , hu_0(jpi,jpj) , ht_0(jpi,jpj) ,     & 
     368         &      hv(jpi,jpj) , hvr(jpi,jpj) , hv_0(jpi,jpj) , ht  (jpi,jpj) , STAT=ierr(6)  ) 
    379369         ! 
    380370      ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) ,                                     & 
    … …  
    387377         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     & 
    388378         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     & 
    389          &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(8) ) 
     379         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1(jpi,jpj) , STAT=ierr(8) ) 
    390380 
    391381      ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) ,                                      & 
    392382         &     tmask_i(jpi,jpj) , umask_i(jpi,jpj), vmask_i(jpi,jpj), fmask_i(jpi,jpj), & 
    393          &     bmask(jpi,jpj)  ,                                                       & 
     383         &     bmask  (jpi,jpj) ,                                                       & 
    394384         &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 
    395385 
    396386! (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) ) 
     387      ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj),                   & 
     388         &      mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) ,           & 
     389         &      mikf(jpi,jpj), ssmask(jpi,jpj), STAT=ierr(10) ) 
    400390 
    401391      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     &  
    … …  
    403393 
    404394      ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(12) ) 
    405  
    406 #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) ) 
    408 #endif 
    409395      ! 
    410396      dom_oce_alloc = MAXVAL(ierr) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r5363 r5836  
    1919   !!   dom_nam        : read and contral domain namelists 
    2020   !!   dom_ctl        : control print for the ocean domain 
     21   !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate) 
    2122   !!---------------------------------------------------------------------- 
    2223   USE oce             ! ocean variables 
    … …  
    2526   USE phycst          ! physical constants 
    2627   USE closea          ! closed seas 
    27    USE in_out_manager  ! I/O manager 
    28    USE lib_mpp         ! distributed memory computing library 
    29  
    3028   USE domhgr          ! domain: set the horizontal mesh 
    3129   USE domzgr          ! domain: set the vertical mesh 
    … …  
    3634   USE c1d             ! 1D vertical configuration 
    3735   USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine) 
     36   ! 
     37   USE in_out_manager  ! I/O manager 
     38   USE lib_mpp         ! distributed memory computing library 
     39   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    3840   USE timing          ! Timing 
    39    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    4041 
    4142   IMPLICIT NONE 
    … …  
    8182      ENDIF 
    8283      ! 
    83                              CALL dom_nam      ! read namelist ( namrun, namdom, namcla ) 
     84                             CALL dom_nam      ! read namelist ( namrun, namdom ) 
    8485                             CALL dom_clo      ! Closed seas and lake 
    8586                             CALL dom_hgr      ! Horizontal mesh 
    … …  
    8889      IF( ln_sco )           CALL dom_stiff    ! Maximum stiffness ratio/hydrostatic consistency 
    8990      ! 
    90       ht_0(:,:) = 0.0_wp                       ! Reference ocean depth at T-points 
    91       hu_0(:,:) = 0.0_wp                       ! Reference ocean depth at U-points 
    92       hv_0(:,:) = 0.0_wp                       ! Reference ocean depth at V-points 
     91      ht_0(:,:) = 0._wp                        ! Reference ocean depth at T-points 
     92      hu_0(:,:) = 0._wp                        ! Reference ocean depth at U-points 
     93      hv_0(:,:) = 0._wp                        ! Reference ocean depth at V-points 
    9394      DO jk = 1, jpk 
    9495         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 
    … …  
    9798      END DO 
    9899      ! 
    99       IF( lk_vvl )           CALL dom_vvl_init ! Vertical variable mesh 
     100      IF( lk_vvl         )   CALL dom_vvl_init ! Vertical variable mesh 
    100101      ! 
    101102      IF( lk_c1d         )   CALL cor_c1d      ! 1D configuration: Coriolis set at T-point 
    … …  
    131132      !! ** input   : - namrun namelist 
    132133      !!              - namdom namelist 
    133       !!              - namcla namelist 
    134134      !!              - namnc4 namelist   ! "key_netcdf4" only 
    135135      !!---------------------------------------------------------------------- 
    … …  
    146146         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 
    147147         &             ppa2, ppkth2, ppacr2 
    148       NAMELIST/namcla/ nn_cla 
    149148#if defined key_netcdf4 
    150149      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 
    … …  
    155154      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run 
    156155      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 
    157 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp ) 
     156901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp ) 
    158157 
    159158      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run 
    160159      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) 
    161 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp ) 
     160902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp ) 
    162161      IF(lwm) WRITE ( numond, namrun ) 
    163162      ! 
    … …  
    251250904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
    252251      IF(lwm) WRITE ( numond, namdom ) 
    253  
     252      ! 
    254253      IF(lwp) THEN 
    255254         WRITE(numout,*) 
    … …  
    293292         WRITE(numout,*) '                                      ppacr2            = ', ppacr2 
    294293      ENDIF 
    295  
     294      ! 
    296295      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon) 
    297296      e3zps_min = rn_e3zps_min 
    … …  
    304303      rdtmax    = rn_rdtmin 
    305304      rdth      = rn_rdth 
    306  
    307       REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection 
    308       READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905) 
    309 905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp ) 
    310  
    311       REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection 
    312       READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 ) 
    313 906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp ) 
    314       IF(lwm) WRITE( numond, namcla ) 
    315  
    316       IF(lwp) THEN 
    317          WRITE(numout,*) 
    318          WRITE(numout,*) '   Namelist namcla' 
    319          WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla 
    320       ENDIF 
    321       IF ( nn_cla .EQ. 1 ) THEN 
    322          IF  ( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2  
    323             CONTINUE 
    324          ELSE 
    325             CALL ctl_stop( 'STOP', 'Cross land advation iplemented only for ORCA2 configuration: cp_cfg = "orca" and jp_cfg = 2 ' ) 
    326          ENDIF 
    327       ENDIF 
    328305 
    329306#if defined key_netcdf4 
    … …  
    409386   END SUBROUTINE dom_ctl 
    410387 
     388 
    411389   SUBROUTINE dom_stiff 
    412390      !!---------------------------------------------------------------------- 
    … …  
    427405      REAL(wp), DIMENSION(4) :: zr1 
    428406      !!---------------------------------------------------------------------- 
    429       rx1(:,:) = 0.e0 
    430       zrxmax   = 0.e0 
    431       zr1(:)   = 0.e0 
    432        
     407      rx1(:,:) = 0._wp 
     408      zrxmax   = 0._wp 
     409      zr1(:)   = 0._wp 
     410      ! 
    433411      DO ji = 2, jpim1 
    434412         DO jj = 2, jpjm1 
    … …  
    455433         END DO 
    456434      END DO 
    457  
    458435      CALL lbc_lnk( rx1, 'T', 1. ) 
    459  
    460       zrxmax = MAXVAL(rx1) 
    461  
     436      ! 
     437      zrxmax = MAXVAL( rx1 ) 
     438      ! 
    462439      IF( lk_mpp )   CALL mpp_max( zrxmax ) ! max over the global domain 
    463  
     440      ! 
    464441      IF(lwp) THEN 
    465442         WRITE(numout,*) 
    … …  
    467444         WRITE(numout,*) '~~~~~~~~~' 
    468445      ENDIF 
    469  
     446      ! 
    470447   END SUBROUTINE dom_stiff 
    471  
    472  
    473448 
    474449   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r5656 r5836  
    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, S. Flavoni) 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      ! 
     129      SELECT CASE( jphgr_msh )   !  type of horizontal mesh   
     130      ! 
     131      CASE ( 0 )                     !==  read in coordinate.nc file  ==! 
     132         ! 
    130133         IF(lwp) WRITE(numout,*) 
    131134         IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in "coordinate" file' 
    132  
    133          CALL hgr_read           ! Defaultl option  :   NetCDF file 
    134  
    135          !                                                ! ===================== 
    136          IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
    137             !                                             ! ===================== 
    138             IF( nn_cla == 0 ) THEN 
    139                ! 
    140                ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u = 20 km) 
    141                ij0 = 102   ;   ij1 = 102   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3 
    142                IF(lwp) WRITE(numout,*) 
    143                IF(lwp) WRITE(numout,*) '             orca_r2: Gibraltar    : e2u reduced to 20 km' 
    144                ! 
    145                ii0 = 160   ;   ii1 = 160        ! Bab el Mandeb (e2u = 18 km) 
    146                ij0 =  88   ;   ij1 =  88   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  18.e3 
    147                                                e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  30.e3 
    148                IF(lwp) WRITE(numout,*) 
    149                IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb: e2u reduced to 30 km' 
    150                IF(lwp) WRITE(numout,*) '                                     e1v reduced to 18 km' 
    151             ENDIF 
    152  
    153             ii0 = 145   ;   ii1 = 146        ! Danish Straits (e2u = 10 km) 
    154             ij0 = 116   ;   ij1 = 116   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3 
    155             IF(lwp) WRITE(numout,*) 
    156             IF(lwp) WRITE(numout,*) '             orca_r2: Danish Straits : e2u reduced to 10 km' 
    157             ! 
     135         ! 
     136         ie1e2u_v = 0                  ! set to unread e1e2u and e1e2v 
     137         ! 
     138         CALL hgr_read( ie1e2u_v )     ! read the coordinate.nc file 
     139         ! 
     140         IF( ie1e2u_v == 0 ) THEN      ! e1e2u and e1e2v have not been read: compute them 
     141            !                          ! e2u and e1v does not include a reduction in some strait: apply reduction 
     142            e1e2u (:,:) = e1u(:,:) * e2u(:,:)    
     143            e1e2v (:,:) = e1v(:,:) * e2v(:,:)  
    158144         ENDIF 
    159  
    160             !                                             ! ===================== 
    161          IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration 
    162             !                                             ! ===================== 
    163             ! This dirty section will be suppressed by simplification process: all this will come back in input files 
    164             ! Currently these hard-wired indices relate to configuration with 
    165             ! extend grid (jpjglo=332) 
    166             ! which had a grid-size of 362x292. 
    167             !  
    168             isrow = 332 - jpjglo 
    169             ! 
    170             ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait (e2u = 20 km) 
    171             ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3 
    172             IF(lwp) WRITE(numout,*) 
    173             IF(lwp) WRITE(numout,*) '             orca_r1: Gibraltar : e2u reduced to 20 km' 
    174  
    175             ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u = 10 km) 
    176             ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3 
    177             IF(lwp) WRITE(numout,*) 
    178             IF(lwp) WRITE(numout,*) '             orca_r1: Bhosporus : e2u reduced to 10 km' 
    179  
    180             ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v = 13 km) 
    181             ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  13.e3 
    182             IF(lwp) WRITE(numout,*) 
    183             IF(lwp) WRITE(numout,*) '             orca_r1: Lombok : e1v reduced to 10 km' 
    184  
    185             ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on] 
    186             ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  8.e3 
    187             IF(lwp) WRITE(numout,*) 
    188             IF(lwp) WRITE(numout,*) '             orca_r1: Sumba : e1v reduced to 8 km' 
    189  
    190             ii0 =  53           ;   ii1 =  53        ! Ombai Strait (e1v = 13 km) 
    191             ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3 
    192             IF(lwp) WRITE(numout,*) 
    193             IF(lwp) WRITE(numout,*) '             orca_r1: Ombai : e1v reduced to 13 km' 
    194  
    195             ii0 =  56           ;   ii1 =  56        ! Timor Passage (e1v = 20 km) 
    196             ij0 = 164 - isrow   ;   ij1 = 145 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3 
    197             IF(lwp) WRITE(numout,*) 
    198             IF(lwp) WRITE(numout,*) '             orca_r1: Timor Passage : e1v reduced to 20 km' 
    199  
    200             ii0 =  55           ;   ii1 =  55        ! West Halmahera Strait (e1v = 30 km) 
    201             ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 30.e3 
    202             IF(lwp) WRITE(numout,*) 
    203             IF(lwp) WRITE(numout,*) '             orca_r1: W Halmahera : e1v reduced to 30 km' 
    204  
    205             ii0 =  58           ;   ii1 =  58        ! East Halmahera Strait (e1v = 50 km) 
    206             ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3 
    207             IF(lwp) WRITE(numout,*) 
    208             IF(lwp) WRITE(numout,*) '             orca_r1: E Halmahera : e1v reduced to 50 km' 
    209             ! 
    210             ! 
    211          ENDIF 
    212  
    213          !                                                ! ====================== 
    214          IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration 
    215             !                                             ! ====================== 
    216             ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u = 20 km) 
    217             ij0 = 327   ;   ij1 = 327   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3 
    218             IF(lwp) WRITE(numout,*) 
    219             IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Gibraltar Strait' 
    220             ! 
    221             ii0 = 627   ;   ii1 = 628        ! Bosphore Strait (e2u = 10 km) 
    222             ij0 = 343   ;   ij1 = 343   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3 
    223             IF(lwp) WRITE(numout,*) 
    224             IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Bosphore Strait' 
    225             ! 
    226             ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u = 40 km) 
    227             ij0 = 232   ;   ij1 = 232   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  40.e3 
    228             IF(lwp) WRITE(numout,*) 
    229             IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Sumba Strait' 
    230             ! 
    231             ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u = 15 km) 
    232             ij0 = 232   ;   ij1 = 232   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  15.e3 
    233             IF(lwp) WRITE(numout,*) 
    234             IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Ombai Strait' 
    235             ! 
    236             ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u = 10 km) 
    237             ij0 = 270   ;   ij1 = 270   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3 
    238             IF(lwp) WRITE(numout,*) 
    239             IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Palk Strait' 
    240             ! 
    241             ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v = 10 km) 
    242             ij0 = 232   ;   ij1 = 233   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3 
    243             IF(lwp) WRITE(numout,*) 
    244             IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e1v at the Lombok Strait' 
    245             ! 
    246             ! 
    247             ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v = 25 km) 
    248             ij0 = 276   ;   ij1 = 276   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  25.e3 
    249             IF(lwp) WRITE(numout,*) 
    250             IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e1v at the Bab el Mandeb' 
    251             ! 
    252          ENDIF 
    253  
    254  
    255          ! N.B. :  General case, lat and long function of both i and j indices: 
    256          !     e1t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdila( zti, ztj ) )**2   & 
    257          !                                  + (                           fsdiph( zti, ztj ) )**2  ) 
    258          !     e1u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdila( zui, zuj ) )**2   & 
    259          !                                  + (                           fsdiph( zui, zuj ) )**2  ) 
    260          !     e1v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdila( zvi, zvj ) )**2   & 
    261          !                                  + (                           fsdiph( zvi, zvj ) )**2  ) 
    262          !     e1f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdila( zfi, zfj ) )**2   & 
    263          !                                  + (                           fsdiph( zfi, zfj ) )**2  ) 
    264          ! 
    265          !     e2t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdjla( zti, ztj ) )**2   & 
    266          !                                  + (                           fsdjph( zti, ztj ) )**2  ) 
    267          !     e2u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdjla( zui, zuj ) )**2   & 
    268          !                                  + (                           fsdjph( zui, zuj ) )**2  ) 
    269          !     e2v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdjla( zvi, zvj ) )**2   & 
    270          !                                  + (                           fsdjph( zvi, zvj ) )**2  ) 
    271          !     e2f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdjla( zfi, zfj ) )**2   & 
    272          !                                  + (                           fsdjph( zfi, zfj ) )**2  ) 
    273  
    274  
    275       CASE ( 1 )                     ! geographical mesh on the sphere with regular grid-spacing 
    276  
     145         ! 
     146      CASE ( 1 )                     !==  geographical mesh on the sphere with regular (in degree) grid-spacing  ==! 
     147         ! 
    277148         IF(lwp) WRITE(numout,*) 
    278149         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere with regular grid-spacing' 
    279150         IF(lwp) WRITE(numout,*) '          given by ppe1_deg and ppe2_deg'  
    280  
     151         ! 
    281152         DO jj = 1, jpj 
    282153            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 
     154               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - 1 + njmpp - 1 ) 
     155               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - 1 + njmpp - 1 ) 
     156               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - 1 + njmpp - 1 ) + 0.5 
     157               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - 1 + njmpp - 1 ) + 0.5 
    287158         ! Longitude 
    288159               glamt(ji,jj) = ppglam0 + ppe1_deg * zti 
    … …  
    307178            END DO 
    308179         END DO 
    309  
    310  
    311       CASE ( 2:3 )                   ! f- or beta-plane with regular grid-spacing 
    312  
     180         ! 
     181      CASE ( 2:3 )                   !==  f- or beta-plane with regular grid-spacing  ==! 
     182         ! 
    313183         IF(lwp) WRITE(numout,*) 
    314184         IF(lwp) WRITE(numout,*) '          f- or beta-plane with regular grid-spacing' 
    315185         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m'  
    316  
     186         ! 
    317187         ! Position coordinates (in kilometers) 
    318188         !                          ========== 
    319          glam0 = 0.e0 
     189         glam0 = 0._wp 
    320190         gphi0 = - ppe2_m * 1.e-3 
    321           
     191         ! 
    322192#if defined key_agrif  
    323193         IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only 
    … …  
    332202         DO jj = 1, jpj 
    333203            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 ) 
     204               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 )       ) 
     205               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) + 0.5 ) 
    336206               glamv(ji,jj) = glamt(ji,jj) 
    337207               glamf(ji,jj) = glamu(ji,jj) 
    338     
    339                gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 )       ) 
     208               ! 
     209               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 )       ) 
    340210               gphiu(ji,jj) = gphit(ji,jj) 
    341                gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 ) + 0.5 ) 
     211               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) + 0.5 ) 
    342212               gphif(ji,jj) = gphiv(ji,jj) 
    343213            END DO 
    344214         END DO 
    345  
     215         ! 
    346216         ! Horizontal scale factors (in meters) 
    347217         !                              ====== 
    … …  
    350220         e1v(:,:) = ppe1_m      ;      e2v(:,:) = ppe2_m 
    351221         e1f(:,:) = ppe1_m      ;      e2f(:,:) = ppe2_m 
    352  
    353       CASE ( 4 )                     ! geographical mesh on the sphere, isotropic MERCATOR type 
    354  
     222         ! 
     223      CASE ( 4 )                     !==  geographical mesh on the sphere, isotropic MERCATOR type  ==! 
     224         ! 
    355225         IF(lwp) WRITE(numout,*) 
    356226         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere, MERCATOR type' 
    357227         IF(lwp) WRITE(numout,*) '          longitudinal/latitudinal spacing given by ppe1_deg' 
    358228         IF ( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' ) 
    359  
     229         ! 
    360230         !  Find index corresponding to the equator, given the grid spacing e1_deg 
    361231         !  and the (approximate) southern latitude ppgphi0. 
    … …  
    365235         ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg ) 
    366236         IF(  ppgphi0 > 0 )  ijeq = -ijeq 
    367  
     237         ! 
    368238         IF(lwp) WRITE(numout,*) '          Index of the equator on the MERCATOR grid:', ijeq 
    369  
     239         ! 
    370240         DO jj = 1, jpj 
    371241            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 
     242               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - ijeq + njmpp - 1 ) 
     243               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - ijeq + njmpp - 1 ) 
     244               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - ijeq + njmpp - 1 ) + 0.5 
     245               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - ijeq + njmpp - 1 ) + 0.5 
    376246         ! Longitude 
    377247               glamt(ji,jj) = ppglam0 + ppe1_deg * zti 
    … …  
    396266            END DO 
    397267         END DO 
    398  
    399       CASE ( 5 )                   ! beta-plane with regular grid-spacing and rotated domain (GYRE configuration) 
    400  
     268         ! 
     269      CASE ( 5 )                   !==  beta-plane with regular grid-spacing and rotated domain ==! (GYRE configuration) 
     270         ! 
    401271         IF(lwp) WRITE(numout,*) 
    402272         IF(lwp) WRITE(numout,*) '          beta-plane with regular grid-spacing and rotated domain (GYRE configuration)' 
    403273         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m' 
    404  
     274         ! 
    405275         ! Position coordinates (in kilometers) 
    406276         !                          ========== 
    407  
     277         ! 
    408278         ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN 
    409          zlam1 = -85 
    410          zphi1 = 29 
     279         zlam1 = -85._wp 
     280         zphi1 =  29._wp 
    411281         ! resolution in meters 
    412          ze1 = 106000. / FLOAT(jp_cfg)             
     282         ze1 = 106000. / REAL( jp_cfg , wp )             
    413283         ! benchmark: forced the resolution to be about 100 km 
    414          IF( nbench /= 0 )   ze1 = 106000.e0      
    415          zsin_alpha = - SQRT( 2. ) / 2. 
    416          zcos_alpha =   SQRT( 2. ) / 2. 
     284         IF( nbench /= 0 )   ze1 = 106000._wp      
     285         zsin_alpha = - SQRT( 2._wp ) * 0.5_wp 
     286         zcos_alpha =   SQRT( 2._wp ) * 0.5_wp 
    417287         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  
     288         IF( nbench /= 0 )   ze1deg = ze1deg / REAL( jp_cfg , wp )   ! benchmark: keep the lat/+lon 
     289         !                                                           ! at the right jp_cfg resolution 
     290         glam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp ) 
     291         gphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp ) 
     292         ! 
    423293         IF( nprint==1 .AND. lwp )   THEN 
    424294            WRITE(numout,*) '          ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha 
    425295            WRITE(numout,*) '          ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0 
    426296         ENDIF 
    427  
     297         ! 
    428298         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  
     299            DO ji = 1, jpi 
     300               zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5 
     301               zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5 
     302               ! 
     303               glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
     304               gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
     305               ! 
     306               glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
     307               gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
     308               ! 
     309               glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
     310               gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
     311               ! 
     312               glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
     313               gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
     314            END DO 
     315         END DO 
     316         ! 
    447317         ! Horizontal scale factors (in meters) 
    448318         !                              ====== 
    … …  
    451321         e1v(:,:) =  ze1     ;      e2v(:,:) = ze1 
    452322         e1f(:,:) =  ze1     ;      e2f(:,:) = ze1 
    453  
     323         ! 
    454324      CASE DEFAULT 
    455325         WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh 
    456326         CALL ctl_stop( ctmp1 ) 
    457  
     327         ! 
    458328      END SELECT 
    459329       
    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 
     330      ! associated horizontal metrics 
     331      ! ----------------------------- 
     332      ! 
     333      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:) 
     334      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:) 
     335      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:) 
     336      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:) 
     337      ! 
     338      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 
     339      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:) 
     340      IF( jphgr_msh /= 0 ) THEN               ! e1e2u and e1e2v have not been set: compute them 
     341         e1e2u (:,:) = e1u(:,:) * e2u(:,:)    
     342         e1e2v (:,:) = e1v(:,:) * e2v(:,:)  
     343      ENDIF 
     344      r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in both cases 
     345      r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 
     346      !    
     347      e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 
     348      e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 
     349 
     350      IF( lwp .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart) 
    489351         WRITE(numout,*) 
    490352         WRITE(numout,*) '          longitude and e1 scale factors' 
    … …  
    4963589300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    & 
    497359            f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 ) 
    498           
     360            ! 
    499361         WRITE(numout,*) 
    500362         WRITE(numout,*) '          latitude and e2 scale factors' 
    … …  
    506368      ENDIF 
    507369 
    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  
    521370 
    522371      ! ================= ! 
    … …  
    525374 
    526375      SELECT CASE( jphgr_msh )   ! type of horizontal mesh 
    527  
     376      ! 
    528377      CASE ( 0, 1, 4 )               ! mesh on the sphere 
    529  
     378         ! 
    530379         ff(:,:) = 2. * omega * SIN( rad * gphif(:,:) )  
    531  
     380         ! 
    532381      CASE ( 2 )                     ! f-plane at ppgphi0  
    533  
     382         ! 
    534383         ff(:,:) = 2. * omega * SIN( rad * ppgphi0 ) 
    535  
     384         ! 
    536385         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1) 
    537  
     386         ! 
    538387      CASE ( 3 )                     ! beta-plane 
    539  
     388         ! 
    540389         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           
     390         zphi0   = ppgphi0 - REAL( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points 
     391         ! 
    543392#if defined key_agrif 
    544393         IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only 
    545394            IF( .NOT. Agrif_Root() ) THEN 
    546               zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m)   &  
    547                     &           / (ra * rad) 
     395              zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 
    548396            ENDIF 
    549397         ENDIF 
    550398#endif          
    551399         zf0     = 2. * omega * SIN( rad * zphi0 )                              ! compute f0 1st point south 
    552  
     400         ! 
    553401         ff(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south) 
    554           
     402         ! 
    555403         IF(lwp) THEN 
    556404            WRITE(numout,*)  
    … …  
    565413            IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff 
    566414         END IF 
    567  
     415         ! 
    568416      CASE ( 5 )                     ! beta-plane and rotated domain (gyre configuration) 
    569  
     417         ! 
    570418         zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0 
    571          zphi0 = 15.e0                                                      ! latitude of the first row F-points 
     419         zphi0 = 15._wp                                                     ! latitude of the first row F-points 
    572420         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south 
    573  
     421         ! 
    574422         ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south) 
    575  
     423         ! 
    576424         IF(lwp) THEN 
    577425            WRITE(numout,*)  
    … …  
    579427            WRITE(numout,*) '          Coriolis parameter varies in this processor from ', ff(nldi,nldj),' to ', ff(nldi,nlej) 
    580428         ENDIF 
    581  
     429         ! 
    582430         IF( lk_mpp ) THEN  
    583431            zminff=ff(nldi,nldj) 
    … …  
    587435            IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff 
    588436         END IF 
    589  
     437         ! 
    590438      END SELECT 
    591439 
    … …  
    596444 
    597445      IF( nperio == 2 ) THEN 
    598          znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / FLOAT( jpi ) 
     446         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi ) 
    599447         IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' ) 
    600448      ENDIF 
    … …  
    605453 
    606454 
    607    SUBROUTINE hgr_read 
     455   SUBROUTINE hgr_read( ke1e2u_v ) 
    608456      !!--------------------------------------------------------------------- 
    609457      !!              ***  ROUTINE hgr_read  *** 
    610458      !! 
    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       !!      
     459      !! ** Purpose :   Read a coordinate file in NetCDF format using IOM 
     460      !! 
    616461      !!---------------------------------------------------------------------- 
    617462      USE iom 
    618  
     463      !! 
     464      INTEGER, INTENT( inout ) ::   ke1e2u_v   ! fag: e1e2u & e1e2v read in coordinate file (=1) or not (=0) 
     465      ! 
    619466      INTEGER ::   inum   ! temporary logical unit 
    620467      !!---------------------------------------------------------------------- 
    621  
     468      ! 
    622469      IF(lwp) THEN 
    623470         WRITE(numout,*) 
    … …  
    625472         WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk 
    626473      ENDIF 
    627        
     474      ! 
    628475      CALL iom_open( 'coordinates', inum ) 
    629        
     476      ! 
    630477      CALL iom_get( inum, jpdom_data, 'glamt', glamt, lrowattr=ln_use_jattr ) 
    631478      CALL iom_get( inum, jpdom_data, 'glamu', glamu, lrowattr=ln_use_jattr ) 
    632479      CALL iom_get( inum, jpdom_data, 'glamv', glamv, lrowattr=ln_use_jattr ) 
    633480      CALL iom_get( inum, jpdom_data, 'glamf', glamf, lrowattr=ln_use_jattr ) 
    634        
     481      ! 
    635482      CALL iom_get( inum, jpdom_data, 'gphit', gphit, lrowattr=ln_use_jattr ) 
    636483      CALL iom_get( inum, jpdom_data, 'gphiu', gphiu, lrowattr=ln_use_jattr ) 
    637484      CALL iom_get( inum, jpdom_data, 'gphiv', gphiv, lrowattr=ln_use_jattr ) 
    638485      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        
     486      ! 
     487      CALL iom_get( inum, jpdom_data, 'e1t'  , e1t  , lrowattr=ln_use_jattr ) 
     488      CALL iom_get( inum, jpdom_data, 'e1u'  , e1u  , lrowattr=ln_use_jattr ) 
     489      CALL iom_get( inum, jpdom_data, 'e1v'  , e1v  , lrowattr=ln_use_jattr ) 
     490      CALL iom_get( inum, jpdom_data, 'e1f'  , e1f  , lrowattr=ln_use_jattr ) 
     491      ! 
     492      CALL iom_get( inum, jpdom_data, 'e2t'  , e2t  , lrowattr=ln_use_jattr ) 
     493      CALL iom_get( inum, jpdom_data, 'e2u'  , e2u  , lrowattr=ln_use_jattr ) 
     494      CALL iom_get( inum, jpdom_data, 'e2v'  , e2v  , lrowattr=ln_use_jattr ) 
     495      CALL iom_get( inum, jpdom_data, 'e2f'  , e2f  , lrowattr=ln_use_jattr ) 
     496      ! 
     497      IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN 
     498         IF(lwp) WRITE(numout,*) 'hgr_read : e1e2u & e1e2v read in coordinates file' 
     499         CALL iom_get( inum, jpdom_data, 'e1e2u'  , e1e2u  , lrowattr=ln_use_jattr ) 
     500         CALL iom_get( inum, jpdom_data, 'e1e2v'  , e1e2v  , lrowattr=ln_use_jattr ) 
     501         ke1e2u_v = 1 
     502      ELSE 
     503         ke1e2u_v = 0 
     504      ENDIF 
     505      ! 
    650506      CALL iom_close( inum ) 
    651507       
     508!!gm   THIS is TO BE REMOVED !!!!!!! 
     509 
    652510! need to be define for the extended grid south of -80S 
    653511! some point are undefined but you need to have e1 and e2 .NE. 0 
    … …  
    676534         e2f=1.0e2 
    677535      END WHERE 
     536!!gm end 
    678537        
    679538    END SUBROUTINE hgr_read 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r5552 r5836  
    1717   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization 
    1818   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option 
     19   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask 
    1920   !!---------------------------------------------------------------------- 
    2021 
    2122   !!---------------------------------------------------------------------- 
    2223   !!   dom_msk        : compute land/ocean mask 
    23    !!   dom_msk_nsa    : update land/ocean mask when no-slip accurate option is used. 
    2424   !!---------------------------------------------------------------------- 
    2525   USE oce             ! ocean dynamics and tracers 
    … …  
    3636 
    3737   PUBLIC   dom_msk         ! routine called by inidom.F90 
    38    PUBLIC   dom_msk_alloc   ! routine called by nemogcm.F90 
    3938 
    4039   !                            !!* Namelist namlbc : lateral boundary condition * 
    … …  
    4241   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition  
    4342   !                                            with analytical eqs. 
    44  
    45  
    46    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  icoord ! Workspace for dom_msk_nsa() 
    4743 
    4844   !! * Substitutions 
    … …  
    5450   !!---------------------------------------------------------------------- 
    5551CONTAINS 
    56     
    57    INTEGER FUNCTION dom_msk_alloc() 
    58       !!--------------------------------------------------------------------- 
    59       !!                 ***  FUNCTION dom_msk_alloc  *** 
    60       !!--------------------------------------------------------------------- 
    61       dom_msk_alloc = 0 
    62 #if defined key_noslip_accurate 
    63       ALLOCATE(icoord(jpi*jpj*jpk,3), STAT=dom_msk_alloc) 
    64 #endif 
    65       IF( dom_msk_alloc /= 0 )   CALL ctl_warn('dom_msk_alloc: failed to allocate icoord array') 
    66       ! 
    67    END FUNCTION dom_msk_alloc 
    68  
    6952 
    7053   SUBROUTINE dom_msk 
    … …  
    129112      !!               tmask_i  : interior ocean mask 
    130113      !!---------------------------------------------------------------------- 
    131       ! 
    132       INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     114      INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    133115      INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers 
    134116      INTEGER  ::   ijf, ijl, ij0, ij1       !   -       - 
    … …  
    199181      END DO   
    200182 
    201 !!gm  ???? 
    202 #if defined key_zdfkpp 
    203       IF( cp_cfg == 'orca' ) THEN 
    204          IF( jp_cfg == 2 )   THEN       ! land point on Bab el Mandeb zonal section 
    205             ij0 =  87   ;   ij1 =  88 
    206             ii0 = 160   ;   ii1 = 161 
    207             tmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0._wp 
    208          ELSE 
    209             IF(lwp) WRITE(numout,*) 
    210             IF(lwp) WRITE(numout,cform_war) 
    211             IF(lwp) WRITE(numout,*) 
    212             IF(lwp) WRITE(numout,*)'          A mask must be applied on Bab el Mandeb strait' 
    213             IF(lwp) WRITE(numout,*)'          in case of ORCAs configurations' 
    214             IF(lwp) WRITE(numout,*)'          This is a problem which is not yet solved' 
    215             IF(lwp) WRITE(numout,*) 
    216          ENDIF 
    217       ENDIF 
    218 #endif 
    219 !!gm end 
    220  
    221183      ! Interior domain mask (used for global sum) 
    222184      ! -------------------- 
    … …  
    284246      ! 3. Ocean/land mask at wu-, wv- and w points  
    285247      !---------------------------------------------- 
    286 &nb